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   !!!!資料目錄，輸出結(jié)果目錄，閾值文件存儲(chǔ)目錄

          !!!!!!!讀取目錄文件
          open(10,file='config.txt',err=2050)
          read(10,'(12x,i4)',err=2050)ns
          read(10,'(12x,a50)',err=2050)datdir  !二進(jìn)制文件的存儲(chǔ)路徑
          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')  !讀文件名，只有站號(hào)。
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)   !!!!定義需要處理的變量數(shù)
       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時(shí)降水量，crr20-20時(shí)降水量，ctm20-20時(shí)最高氣溫，ctn20-20時(shí)最低氣溫，ctd20-20時(shí)平均氣溫
      
    if(ieof/=6915)then
       ieof=-99
       print*,'您無權(quán)進(jìn)行此操作，請聯(lián)系管理員'
       return
       endif
      
       if(i_dim/=367)then
       ieof=-10
       print*,'資料數(shù)組長度錯(cuò)誤，i_dim=   ',i_dim
       return
       endif
      
       if(i_dim==367)then
!!!!!!!判斷當(dāng)前需要寫入的變量        
        do k=1,nn
        if(t_r==ysm(k))kk=k
        enddo
        
        do i=1,i_dim-1
        ix0=b0(i)
!!!!!!!對當(dāng)前寫入數(shù)據(jù)做簡單的變換        
     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   !!!!!!數(shù)組最后一個(gè)值賦為年
        
!!!!!!!寫數(shù)據(jù)文件
        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*,'打開文件錯(cuò)誤',wysm(1:len1),ysf(kk),ysm(kk),stat,'.dat'
       close(8)
       return
999    ieof=-2
       print*,'寫入文件錯(cuò)誤',wysm(1:len1),ysf(kk),ysm(kk),stat,'.dat'
       close(8)
       return
      
end subroutine write_hd

!!!!對輸入的數(shù)值ix0做簡單轉(zhuǎn)換
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:
麻煩各位幫忙看看，這是一個(gè)對數(shù)據(jù)進(jìn)行簡單加密后，對數(shù)據(jù)進(jìn)行二進(jìn)制轉(zhuǎn)換，子程序write_hd就是轉(zhuǎn)二進(jìn)制，子程序xzen_ja是數(shù)據(jù)加密~~~~

fortran不能面向?qū)ο螅�我現(xiàn)在想把這個(gè)程序轉(zhuǎn)成VB，現(xiàn)在我看不懂這個(gè)程序是 ...