[½»Á÷] ¡¾ÇóÖú¡¿ÇóÖú£º°ïæ¿´ÏÂÕâ¸ö³ÌÐòÊÇÔõôת¶þ½øÖƵĿ©£¬Ð»Ð»°¡ ÒÑÓÐ1È˲ÎÓë

program data_conv
      integer ns
      integer,allocatable :: sta(:)
      character t_r*3,cst*5
      integer(kind=2) tm(367)
      integer ln,ld,i_dim,ieof
      character datdir*50,outdir*50,hisdir*50,logdir*50   !!!!×ÊÁÏĿ¼£¬Êä³ö½á¹ûĿ¼£¬ãÐÖµÎļþ´æ´¢Ä¿Â¼

          !!!!!!!¶ÁȡĿ¼Îļþ
          open(10,file='config.txt',err=2050)
          read(10,'(12x,i4)',err=2050)ns
          read(10,'(12x,a50)',err=2050)datdir  !¶þ½øÖÆÎļþµÄ´æ´¢Â·¾¶
          read(10,'(12x,a50)',err=2050)outdir
          read(10,'(12x,a50)',err=2050)hisdir
          read(10,'(12x,a50)',err=2050)logdir
          close(10)
          goto 90
2050  print*,'input the direct access is err, the run will stop'
      stop 9999

90    continue

    allocate(sta(ns))
      t_r='ctm'
open(110,file='station.txt')  !¶ÁÎļþÃû£¬Ö»ÓÐÕ¾ºÅ¡£
do i=1,ns
read(110,*)sta(i)
enddo
close(110)
do ln=1,ns
       write(cst,'(i5)')sta(ln)
       tm=32766
       open(20,file='e:\extr\ԭʼ×ÊÁÏ\hisctm\'//t_r//cst//'.dat',err=999)  !ָʾÎı¾ÎļþµÄ·¾¶
98     read(20,*,end=999)nsta,nya
       read(20,'(30i6)',end=999)(tm(ld),ld=1,366)
       ly=nya-1950
       ieof=6915
       call write_hd(t_r,sta(ln),ly,i_dim,tm,ieof,datdir)
       goto 98   
999   continue               
      close(20)
      enddo  !!!for do ln=1,ns  
      deallocate(sta)   
      
end program data_conv

subroutine write_hd(t_r,ist,irecs,i_dim,b0,ieof,wysm)
       parameter(nn=7)   !!!!¶¨ÒåÐèÒª´¦ÀíµÄ±äÁ¿Êý
       integer(kind=2) b0(i_dim)
       integer ieof,ist,irecs
       character t_r*3,stat*5,ysm(nn)*3,ysf(nn)*7,wysm*50
       data ysm/'crd','crr','ctm','ctn','ctd','crs','cci'/
       data ysf/'hiscrd\','hiscrr\','hisctm\','hisctn\','hisctd\','hiscrs/','hiscci\'/
           integer len1
!!!!!!!crd08-08ʱ½µË®Á¿£¬crr20-20ʱ½µË®Á¿£¬ctm20-20ʱ×î¸ßÆøΣ¬ctn20-20ʱ×îµÍÆøΣ¬ctd20-20ʱƽ¾ùÆøÎÂ
      
    if(ieof/=6915)then
       ieof=-99
       print*,'ÄúÎÞȨ½øÐд˲Ù×÷£¬ÇëÁªÏµ¹ÜÀíÔ±'
       return
       endif
      
       if(i_dim/=367)then
       ieof=-10
       print*,'×ÊÁÏÊý×鳤¶È´íÎó£¬i_dim=   ',i_dim
       return
       endif
      
       if(i_dim==367)then
!!!!!!!Åжϵ±Ç°ÐèҪдÈëµÄ±äÁ¿        
        do k=1,nn
        if(t_r==ysm(k))kk=k
        enddo
        
        do i=1,i_dim-1
        ix0=b0(i)
!!!!!!!¶Ôµ±Ç°Ð´ÈëÊý¾Ý×ö¼òµ¥µÄ±ä»»        
     if(t_r(1:2)=='cr') call xzen_ja(ist,i+5,ix0)
        if(t_r(1:2)=='ct') call xzen_ja(ist,i+10,ix0)
        b0(i)=ix0
        enddo
        b0(i_dim)=irecs+1950   !!!!!!Êý×é×îºóÒ»¸öÖµ¸³ÎªÄê
        
!!!!!!!дÊý¾ÝÎļþ
        write(stat,'(i5)')ist
        close(8)
                len1=len_trim(wysm)
        open(8,file=wysm(1:len1)//ysf(kk)//ysf(kk)//stat//'.dat',access='direct',recl=2*i_dim,err=99)

        write(8,rec=irecs,err=999)b0

        close(8)
        ieof=1
        return
        
       endif
      
99     ieof=0
       print*,'´ò¿ªÎļþ´íÎó',wysm(1:len1),ysf(kk),ysm(kk),stat,'.dat'
       close(8)
       return
999    ieof=-2
       print*,'дÈëÎļþ´íÎó',wysm(1:len1),ysf(kk),ysm(kk),stat,'.dat'
       close(8)
       return
      
end subroutine write_hd

!!!!¶ÔÊäÈëµÄÊýÖµix0×ö¼òµ¥×ª»»
subroutine xzen_ja(ist,i,ix0)
      integer ist,i,ix0
      integer maxx,mins
      
      maxx=30000
      mins=-9990
      is3=mod(ist,3)
      it3=mod(i,3)
      it5=mod(i,5)
      it7=mod(i,7)
      it11=mod(i,11)
      it13=mod(i,13)
      it17=mod(i,17)
      
      if(ix0mins)then
      if(is3==0)then
       if(it3==0)ix0=ix0+it5+it17+it13
       if(it3==1)ix0=ix0+it7+it17+it11
       if(it3==2)ix0=ix0+it5+it11+it13
      else
       if(it3==0)ix0=ix0+it7+it11+it13
       if(it3==1)ix0=ix0+it3+it13+it11
       if(it3==2)ix0=ix0+it5+it11+it17
      endif
      else
       ix0=ix0
      endif
      
      return
end subroutine xzen_ja

Originally posted by yhwsmile at 2010-09-29 09:40:37:
Âé·³¸÷λ°ïæ¿´¿´£¬ÕâÊÇÒ»¸ö¶ÔÊý¾Ý½øÐмòµ¥¼ÓÃܺ󣬶ÔÊý¾Ý½øÐжþ½øÖÆת»»£¬×Ó³ÌÐòwrite_hd¾ÍÊÇת¶þ½øÖÆ£¬×Ó³ÌÐòxzen_jaÊÇÊý¾Ý¼ÓÃÜ~~~~

fortran²»ÄÜÃæÏò¶ÔÏó£¬ÎÒÏÖÔÚÏë°ÑÕâ¸ö³ÌÐòת³ÉVB£¬ÏÖÔÚÎÒ¿´²»¶®Õâ¸ö³ÌÐòÊÇ ...