您所在位置：主题：据说是要在linux下运行，求改编成windows，小弟写论文用，能帮就帮下吧
qwert590202
[专家分：0] 发布于 2010-05-10 16:48:00
[size=3][color=FF0000][color=000080][size=6][size=5][size=4][size=3][size=3][size=3][size=1][size=6][size=3]基本如题，我只发一段子程序，整个程序有66K，见附件。程序不会错的，是国外网站云资料的标准读取程序，但有备注要在linux或服务器下读取，如果要在windows下运行需要修改，我运行后有对话框提示读取错误。具体哪要改我也不懂，主要是论文要用的资料，希望能给予解答,不甚感激。邮箱chencong100@sina.com[/size][/size][/size][/size][/size][/size][/size][/size][/size][/color][/color][/size]
SUBROUTINE D2READ(IRC)
PARAMETER ( MAXVAR = 130 )
PARAMETER ( NUMBOX = 100 )
PARAMETER ( MAXLAT = 72 )
PARAMETER ( MAXLON = 144 )
PARAMETER ( IUNDEF = 255 )
PARAMETER ( RUNDEF = -1000.0 )
COMMON /D2BUFS/ CHRBUF(MAXVAR,NUMBOX)
CHARACTER*1 CHRBUF
COMMON /D2DATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON)
COMMON /D2HEAD/ LUND2,IREC,IFILE,IYEAR,MONTH,IDAY,IUTC
$ ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND
COMMON /D2GRID/ NCELLS(MAXLAT),ICELLS(MAXLAT)
SAVE IDECOD
C*--------------------------------------------------------------------*C
C* INITIALIZE THE OUTPUT ARRAYS (IVAR AND RVAR) *C
C*--------------------------------------------------------------------*C
DO 100 LON=1,MAXLON
DO 100 I=1,MAXVAR
IVAR(I,LON) = IUNDEF
RVAR(I,LON) = RUNDEF
100 CONTINUE
C*--------------------------------------------------------------------*C
C* LOOP OVER ALL BOXES FOR THIS LAT *C
C*--------------------------------------------------------------------*C
NLON = ICELLS(LAT)
NPREV = NCELLS(LAT)
DO 500 LON=1,NLON
NBOX = NPREV + LON
C*--------------------------------------------------------------------*C
C* IF BOX IS CONTAINED IN THE CURRENT RECORD, UNPACK IT *C
C*--------------------------------------------------------------------*C
200 CONTINUE
IF ( NBOX .GE. IBXBEG ) THEN
IF ( NBOX .LE. IBXEND ) THEN
IF ( ICHAR(CHRBUF(1,IDECOD+1)) .GT. LAT ) GOTO 510
IDECOD = IDECOD + 1
ILON = ICHAR(CHRBUF(2,IDECOD))
DO 300 I=1,MAXVAR
IVAR(I,ILON) = ICHAR(CHRBUF(I,IDECOD))
300 CONTINUE
C*--------------------------------------------------------------------*C
C* OTHERWISE READ THE NEXT RECORD *C
C*--------------------------------------------------------------------*C
ELSE
CALL D2REC(IRC)
IDECOD = 1
IF ( IRC .EQ. 0 ) THEN
GOTO 200
ELSE
GOTO 900
END IF
END IF
END IF
500 CONTINUE
510 CONTINUE
C*--------------------------------------------------------------------*C
C* END *C
C*--------------------------------------------------------------------*C
900 CONTINUE
RETURN
END
SUBROUTINE D2READ(IRC)
PARAMETER ( MAXVAR = 130 )
PARAMETER ( NUMBOX = 100 )
PARAMETER ( MAXLAT = 72 )
PARAMETER ( MAXLON = 144 )
PARAMETER ( IUNDEF = 255 )
PARAMETER ( RUNDEF = -1000.0 )
COMMON /D2BUFS/ CHRBUF(MAXVAR,NUMBOX)
CHARACTER*1 CHRBUF
COMMON /D2DATA/ LAT,NLON,IVAR(MAXVAR,MAXLON),RVAR(MAXVAR,MAXLON)
COMMON /D2HEAD/ LUND2,IREC,IFILE,IYEAR,MONTH,IDAY,IUTC
$ ,LATBEG,LATEND,LONBEG,LONEND,IBXBEG,IBXEND
COMMON /D2GRID/ NCELLS(MAXLAT),ICELLS(MAXLAT)
SAVE IDECOD
C*--------------------------------------------------------------------*C
C* INITIALIZE THE OUTPUT ARRAYS (IVAR AND RVAR) *C
C*--------------------------------------------------------------------*C
DO 100 LON=1,MAXLON
DO 100 I=1,MAXVAR
IVAR(I,LON) = IUNDEF
RVAR(I,LON) = RUNDEF
100 CONTINUE
C*--------------------------------------------------------------------*C
C* LOOP OVER ALL BOXES FOR THIS LAT *C
C*--------------------------------------------------------------------*C
NLON = ICELLS(LAT)
NPREV = NCELLS(LAT)
DO 500 LON=1,NLON
NBOX = NPREV + LON
C*--------------------------------------------------------------------*C
C* IF BOX IS CONTAINED IN THE CURRENT RECORD, UNPACK IT *C
C*--------------------------------------------------------------------*C
200 CONTINUE
IF ( NBOX .GE. IBXBEG ) THEN
IF ( NBOX .LE. IBXEND ) THEN
IF ( ICHAR(CHRBUF(1,IDECOD+1)) .GT. LAT ) GOTO 510
IDECOD = IDECOD + 1
ILON = ICHAR(CHRBUF(2,IDECOD))
DO 300 I=1,MAXVAR
IVAR(I,ILON) = ICHAR(CHRBUF(I,IDECOD))
300 CONTINUE
C*--------------------------------------------------------------------*C
C* OTHERWISE READ THE NEXT RECORD *C
C*--------------------------------------------------------------------*C
ELSE
CALL D2REC(IRC)
IDECOD = 1
IF ( IRC .EQ. 0 ) THEN
GOTO 200
ELSE
GOTO 900
END IF
END IF
END IF
500 CONTINUE
510 CONTINUE
C*--------------------------------------------------------------------*C
C* END *C
C*--------------------------------------------------------------------*C
900 CONTINUE
RETURN
END