请选择 进入手机版 | 继续访问电脑版
爱气象,爱气象家园! 

气象家园

 找回密码
 立即注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

搜索
查看: 2557|回复: 1

求助大神!wosis文件转换成micaps文件?

[复制链接]

新浪微博达人勋

发表于 2018-12-10 15:12:22 | 显示全部楼层 |阅读模式

登录后查看更多精彩内容~

您需要 登录 才可以下载或查看,没有帐号?立即注册 新浪微博登陆

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

密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2018-12-17 10:27:26 | 显示全部楼层
问题已解决!
密码修改失败请联系微信:mofangbao
您需要登录后才可以回帖 登录 | 立即注册 新浪微博登陆

本版积分规则

Copyright ©2011-2014 bbs.06climate.com All Rights Reserved.  Powered by Discuz! (京ICP-10201084)

本站信息均由会员发表,不代表气象家园立场,禁止在本站发表与国家法律相抵触言论

快速回复 返回顶部 返回列表