- 积分
- 1807
- 贡献
-
- 精华
- 在线时间
- 小时
- 注册时间
- 2017-1-17
- 最后登录
- 1970-1-1
|
登录后查看更多精彩内容~
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
有一个前辈给我的Fortran文件,但是运行不出来,改了时间却总是转换成同一天。。有没有大神帮我看下是否有错?
!/////// 报文解码WOSIS转MICAPS格式数据 ////////
USE MSFLIB
CHARACTER day*8 , d_day*8, DMtime(8)*2
INTEGER(2) result
data DMtime/'18','21','00','03','06','09','12','15'/ !北京时:+8
OPEN(1,FILE='D:\micapsdata\WosisToMicaps\data_fname.txt') !///
DO WHILE(.TRUE.)
READ(1,*,END=999) day
!高空 ------------------------------------------------
WRITE(*,*) "高空图转Micaps *****************"
DO J=1,2
IF(J==1) d_day = day(3:8)//"00" !08点
IF(J==2) d_day = day(3:8)//"12" !20点
OPEN(2,FILE='D:\micapsdata\datatran\WSDAT.DAT') !///
write(2,'(A8)') d_day
close(2)
CALL READ_FN_high(d_day)
WRITE(*,*) '高空图: '//day//'08'
CALL writeGK_CL_bat
result =RUNQQ('D:\micapsdata\datatran\CL_GK.bat', d_day)
ENDDO
10 CONTINUE
!地面 -------------------------------------------------------
WRITE(*,*) "地面图转Micaps ******************** "
DO J=1,8
d_day = day(3:8)//DMtime(j) !"18" !18点 北京时02
OPEN(2,FILE='D:\micapsdata\datatran\WSDAT.DAT') !///
write(2,'(A8)') d_day
close(2)
CALL READ_FN_surface(d_day)
WRITE(*,*) '地面图: '//day//DMtime(j)
CALL writeDM_CL_bat
result = RUNQQ('D:\micapsdata\datatran\CL_DM.bat',d_day)
ENDDO
ENDDO
999 close(1)
END
!//----------------------------------------------------------
SUBROUTINE writeDM_CL_bat
open(10,file='D:\micapsdata\datatran\CL_DM.bat')
write(10,'("cd d:\micapsdata\datatran\")')
write(10,'("d:\micapsdata\datatran\ptrans0")') !ptrans0程序进行报文解码,path0.dat为配置文件,产生中间文件aaxx1.dat和ttaa1.dat
write(10,'("d:\micapsdata\datatran\ptransax")') !ptransax等进行地面数据格式转换,产生综合填图和单要素填图数据,pathax.dat包含了各输出文件的目录,aaxxdat.dat为地面站号表,data3dm.txt为第三类数据的参数文件
write(10,'("d:\micapsdata\datatran\ptransbx")') !船舶报解码程序ptransbx和ptransbb,并加入到填图数据中
write(10,'("d:\micapsdata\datatran\ptransbb")')
write(10,'("d:\micapsdata\datatran\pwdemi")') !地面常规数据客观分析程序pwdemi.exe
write(10,'("d:\micapsdata\datatran\ptransty")') !台风报处理程序ptransty.和ptranst
write(10,'("d:\micapsdata\datatran\ptransto")')
write(10,'("d:\micapsdata\datatran\ptranscs")') !城市预报报处理程序ptranscs,产生中间文件dm????.dat和gg????.dat
close(10)
end
!//-------------------------------------------------------------
SUBROUTINE writeGK_CL_bat
open(10,file='D:\micapsdata\datatran\CL_GK.bat')
write(10,'("cd d:\micapsdata\datatran\")')
write(10,'("d:\micapsdata\datatran\ptrans0")') !对报文进行译码,产生中间文件aaxx1.dat(地面)或ttaa1.dat(高空)
write(10,'("d:\micapsdata\datatran\ptranstp")') !输入文件ttaa1.dat,pathtp.dat包含了各输出文件的目录,产生综合填图和单要素填图数据
write(10,'("d:\micapsdata\datatran\pwgako")') !pwdemi.exe或pwgako.exe程序产生等值线和流线数据,pathgk.dat包含了各输出文件的目录
write(10,'("d:\micapsdata\datatran\pwphyl")') !pwphyl.exe程序产生诊断物理量数据,pathpy.dat包含了各输出文件的目录
close(10)
END
!//高空数据转换 ================================================
SUBROUTINE READ_FN_high(d_day)
CHARACTER A*8000, d_day*8
OPEN(11,FILE='D:\micapsdata\wosis图\'//d_day//'.UWE') !///
OPEN(33,FILE='D:\micapsdata\datatran\fn.dat') !///
10 READ(11,'(A)',END=99) A
NUM_A = LENA(A)
CALL telex_breckaway(A, NUM_A)
!PAUSE
GOTO 10
99 CONTINUE
CLOSE(33)
CLOSE(11)
END
!// 高空报文分组输出------------------------
subroutine telex_breckaway(DATALINE, NUM_A)
CHARACTER :: DATALINE1(NUM_A) ,DATALINE*(*)
CHARACTER :: SDATA(5), NUM(100)*5
CHARACTER(LEN=5) :: SDATA1
INTEGER :: NUM_A
!INTEGER :: TEMP = 0
INTEGER :: I, J, K, X ,LINE, LINE_MOD
!L=LEN(DATALINE)
DO I =1, NUM_A
DATALINE1(I) = DATALINE(I:I)
ENDDO
I = 1
J = 1
DO K=1, NUM_A
IF(DATALINE1(K)/=' '.AND.DATALINE1(K)/='=')THEN
SDATA(J) = DATALINE1(K)
J = J + 1
ELSE IF(DATALINE1(K)==' '.OR.DATALINE1(K)=='=')THEN
DO X = 1, J-1
SDATA1(X:X) = SDATA(X)
ENDDO
! READ(SDATA1,"(I<J-1>)") TEMP
NUM(I) = SDATA1
I = I + 1
J = 1
ENDIF
IF(DATALINE1(K)=='=') EXIT
ENDDO
!WRITE(*,*) "I=",I-1 !报文组数
LINE = INT((I-1)/10)
LINE_MOD = MOD((I-1),10)
!WRITE(*,*) LINE,LINE_MOD
IF (LINE/=0) THEN
WRITE(33,'((A4," "),9(A5," "))') NUM(1),(NUM(K),K=2,10) !每行写10组
IF(LINE>1)THEN
DO KK=1,LINE-1
KKK=KK*10+1
KKKK=(KK+1)*10
WRITE(33,'(10(A5," "))') (NUM(K),K=KKK,KKKK) !余下的写一行
ENDDO
ENDIF
ENDIF
WRITE(33,'(<LINE_MOD>(A5," "),A1)') (NUM(10*LINE+K),K=1,LINE_MOD),DATALINE1(NUM_A)
! DO II =1,I-1
! WRITE(33,*) NUM(II) !各组报文内容
! ENDDO
! WRITE(33,*) DATALINE1(NUM_A) ! "="
! PAUSE
END
!//地面数据转换=============================================
SUBROUTINE READ_FN_surface(d_day)
CHARACTER A*8000, d_day*8
OPEN(11,FILE='D:\micapsdata\wosis图\'//d_day//'.SWE') !///
OPEN(33,FILE='D:\micapsdata\datatran\fn.dat') !///
10 READ(11,'(A)',END=99) A
NUM_A = LENA(A)
CALL telex_surface(A, NUM_A, d_day)
!PAUSE
GOTO 10
99 CONTINUE
CLOSE(33)
CLOSE(11)
END
!// 地面报文分组输出
subroutine telex_surface(DATALINE, NUM_A, d_day)
CHARACTER :: DATALINE1(NUM_A) ,DATALINE*(*) , d_day*8
CHARACTER :: SDATA(5), NUM(100)*5
CHARACTER(LEN=5) :: SDATA1
INTEGER :: NUM_A
!INTEGER :: TEMP = 0
INTEGER :: I, J, K, X ,LINE, LINE_MOD
!L=LEN(DATALINE)
DO I =1, NUM_A
DATALINE1(I) = DATALINE(I:I)
ENDDO
I = 1
J = 1
DO K=1, NUM_A
IF(DATALINE1(K)/=' '.AND.DATALINE1(K)/='=')THEN
SDATA(J) = DATALINE1(K)
J = J + 1
ELSE IF(DATALINE1(K)==' '.OR.DATALINE1(K)=='=')THEN
DO X = 1, J-1
SDATA1(X:X) = SDATA(X)
ENDDO
! READ(SDATA1,"(I<J-1>)") TEMP
NUM(I) = SDATA1
I = I + 1
J = 1
ENDIF
IF(DATALINE1(K)=='=') EXIT
ENDDO
!WRITE(*,*) "I=",I-1 !报文组数
LINE = INT((I-1)/10)
LINE_MOD = MOD((I-1),10)
!WRITE(*,*) LINE,LINE_MOD
IF(NUM(1)=="AAXX1")THEN
WRITE(33,'(A4," ",A4,"1")') NUM(1),d_day(5:8) !写报头
IF(LINE/=0)THEN
WRITE(33,'(9(A5," "))') (NUM(K),K=2,10) !写报文
IF(LINE>1)THEN
DO KK=1,LINE-1
KKK=KK*10+1
KKKK=(KK+1)*10
WRITE(33,'(10(A5," "))') (NUM(K),K=KKK,KKKK) !余下的写一行
ENDDO
ENDIF
WRITE(33,'(<LINE_MOD-1>(A5," "),A5,A1)') (NUM(10*LINE+K),K=1,LINE_MOD),DATALINE1(NUM_A)
ELSE IF(LINE==0)THEN
WRITE(33,'(<LINE_MOD-2>(A5," "),A5,A1)') (NUM(K),K=2,LINE_MOD),DATALINE1(NUM_A)
ENDIF
ENDIF
! DO II =1,I-1
! WRITE(33,*) NUM(II) !各组报文内容
! ENDDO
! WRITE(33,*) DATALINE1(NUM_A) ! "="
! PAUSE
END
!///
integer function LENA(A) !字符串A的长度(去除尾部空格)
character A*(*)
integer L
L=LEN(A)
LENA=0
do 10 i=L,1,-1
if(a(i:i).ne.' ') goto 20
! write(*,*) "a(",i,")=",a(i:i)
10 continue
GOTO 30
20 LENA=i
30 CONTINUE
end
|
|