var/convertor/wave2grid_kma/REDGES.inc

   1       SUBROUTINE REDGES
   2      I(NGSFL ,IMAX  ,JMAX  ,KMAX  ,KTLAG ,IDATE ,IDCHCK,
   3      O IDGES ,AGD   ,BGD   ,AGM   ,BGM   ,GCWC  ,GCVR  ,GUMB  ,
   4      W IDA   ,IDSST )
   5 C
   6       INTEGER IDGES(5), IDATE(5), IDSST(5)
   7       DIMENSION GCWC(IMAX*JMAX,KMAX), GCVR(IMAX*JMAX,KMAX),
   8      1          GUMB(IMAX*JMAX,KMAX)
   9       DIMENSION AGD(KMAX+1), BGD(KMAX+1), AGM(KMAX+1), BGM(KMAX+1)
  10 c     INTEGER*2 IDA(IMAX*JMAX)    !shc-rizvi
  11       INTEGER   IDA(IMAX*JMAX/2)    !shc-rizvi
  12 C
  13       CHARACTER*4 TYPE, EXPR, KTUNIT, NPROD, NPROM, VCODD, VCODM
  14       CHARACTER*8 FILE, MODEL, RESL
  15       CHARACTER*80 CINF(10)
  16       CHARACTER*4 LEVEL, ELEM
  17       CHARACTER*32 TITLE
  18       CHARACTER*16 UNIT
  19 C
  20 C   =================================================================
  21 C   >>>   DATA CHECK                                              <<<
  22 C   =================================================================
  23       READ(NGSFL,ERR=1,END=1)
  24       GOTO 2
  25     1 WRITE(6,*) '## I CANNOT READ FCST FILE'
  26       CALL RESET( GCWC, IMAX*JMAX*KMAX )
  27       CALL RESET( GCVR, IMAX*JMAX*KMAX )
  28       CALL RESET( GUMB, IMAX*JMAX*KMAX )
  29       RETURN
  30     2 REWIND NGSFL
  31 C
  32 C   =================================================================
  33 C   >>>   HEADER                                                  <<<
  34 C   =================================================================
  35       CALL REDHED
  36      I(NGSFL ,
  37      O TYPE  ,IDGES ,FILE  ,MODEL ,RESL  ,EXPR  ,KTUNIT,IDTYPE,
  38      O IBACK ,NNSP  ,
  39      O IMD   ,JMD   ,NPROD ,FLATID,FLONID,
  40      O XID   ,XJD   ,XLATD ,XLOND ,
  41      O VCODD ,KMD   ,AGD   ,BGD   ,
  42      O IMM   ,JMM   ,NPROM ,FLATIM,FLONIM,
  43      O XIM   ,XJM   ,XLATM ,XLONM ,
  44      O VCODM ,KMM   ,AGM   ,BGM   ,
  45      O CINF  )
  46       WRITE(6,*)'GUESS FILE ',IDGES, FILE, MODEL, RESL, EXPR
  47 C
  48 C   =================================================================
  49 C   >>>   DATE CHECK                                              <<<
  50 C   =================================================================
  51       IF( IDCHCK.EQ.1 ) THEN
  52         CALL CVDATE( IDSST, IDGES, KTLAG )
  53         IF( IDATE(1).NE.IDSST(1).OR.IDATE(2).NE.IDSST(2).OR.
  54      1      IDATE(3).NE.IDSST(3) ) THEN
  55           WRITE(6,*) 'GFEG : DATE CHECK ERROR'
  56           STOP 999
  57         ENDIF
  58       ENDIF
  59 C
  60 C   =================================================================
  61 C   >>>   SPECIAL                                                 <<<
  62 C   =================================================================
  63       DO 10 I=1,NNSP
  64         READ(NGSFL)
  65    10 CONTINUE
  66 C
  67 C   =================================================================
  68 C   >>>   CWC, CVR                                                <<<
  69 C   =================================================================
  70       DO 110 K=1,KMAX
  71   100 CALL REDDAT
  72      I(NGSFL ,
  73      O IDGES , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  74      O GCWC(1,K), IRTN  ,
  75      I IMD   , JMD   , 1     ,
  76      W BASE  , AMP   , IDA   )
  77       IF(KT.NE.KTLAG.OR.LEVEL.EQ.'SURF'.OR.ELEM.NE.'CWC ') GOTO 100
  78   110 CONTINUE
  79 C
  80       DO 210 K=1,KMAX
  81   200 CALL REDDAT
  82      I(NGSFL ,
  83      O IDGES , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  84      O GCVR(1,K), IRTN  ,
  85      I IMD   , JMD   , 1     ,
  86      W BASE  , AMP   , IDA   )
  87       IF(KT.NE.KTLAG.OR.LEVEL.EQ.'SURF'.OR.ELEM.NE.'CVR ') GOTO 200
  88   210 CONTINUE
  89 C
  90 C   =================================================================
  91 C   >>>   UMB                                                     <<<
  92 C   =================================================================
  93       DO 310 K=1,KMAX
  94   300 CALL REDDAT
  95      I(NGSFL ,
  96      O IDGES , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  97      O GUMB(1,K), IRTN  ,
  98      I IMD   , JMD   , 1     ,
  99      W BASE  , AMP   , IDA   )
 100       IF(KT.NE.KTLAG.OR.LEVEL.EQ.'SURF'.OR.ELEM.NE.'UMB ') GOTO 300
 101   310 CONTINUE
 102 C
 103       WRITE(6,*) '## READ FCST-ETA NORMAL END'
 104       RETURN
 105       END SUBROUTINE REDGES