var/convertor/wave2grid_kma/REDANL.inc

   1       SUBROUTINE REDANL
   2      I(NALFL ,IMAX  ,JMAX  ,KMAX  ,
   3      O IDATE ,AAD   ,BBD   ,AAM   ,BBM   ,CINF   ,
   4      O PS    ,GZ    ,GU    ,GV    ,GQ    ,GT     ,
   5      O LARHM ,
   6      W IDA   ,TYPE  ,EXPR  ,KTUNIT,NPROD ,NPROM ,VCODD ,VCODM ,
   7      W FILE  ,MODEL ,RESL  ,LEVEL ,ELEM  ,TITLE ,UNIT  )
   8 C
   9       INTEGER IDATE(5)
  10       DIMENSION PS(IMAX*JMAX)
  11       DIMENSION GZ(IMAX*JMAX,KMAX), GU(IMAX*JMAX,KMAX),
  12      1          GV(IMAX*JMAX,KMAX), GQ(IMAX*JMAX,KMAX),
  13      2          GT(IMAX*JMAX,KMAX)
  14       CHARACTER*80 CINF(10)
  15       DIMENSION AAD(KMAX+1), AAM(KMAX+1), BBD(KMAX+1), BBM(KMAX+1)
  16 c     INTEGER*2 IDA(IMAX*JMAX)    !shc-rizvi
  17       INTEGER   IDA(IMAX*JMAX/2)    !shc-rizvi
  18 C
  19       CHARACTER*4 TYPE, EXPR, KTUNIT, NPROD, NPROM, VCODD, VCODM
  20       CHARACTER*8 FILE, MODEL, RESL
  21       CHARACTER*4 LEVEL, ELEM
  22       CHARACTER*32 TITLE
  23       CHARACTER*16 UNIT
  24 C
  25 C
  26 C   =================================================================
  27 C   >>>   HEADER                                                  <<<
  28 C   =================================================================
  29       CALL REDHED
  30      I(NALFL ,
  31      O TYPE  ,IDATE ,FILE  ,MODEL ,RESL  ,EXPR  ,KTUNIT,IDTYPE,
  32      O IBACK ,NNSP  ,
  33      O IMD   ,JMD   ,NPROD ,FLATID,FLONID,
  34      O XID   ,XJD   ,XLATD ,XLOND ,
  35      O VCODD ,KMD   ,AAD   ,BBD   ,
  36      O IMM   ,JMM   ,NPROM ,FLATIM,FLONIM,
  37      O XIM   ,XJM   ,XLATM ,XLONM ,
  38      O VCODM ,KMM   ,AAM   ,BBM   ,
  39      O CINF  )
  40       WRITE(6,*)'ANAL FILE ',IDATE, FILE, MODEL, RESL, EXPR
  41       IF( FILE.NE.'ANALETA ' ) THEN
  42         WRITE(6,*) 'FILE ERROR! THIS IS NOT ANAL DATA'
  43         STOP 999
  44       ENDIF
  45 C
  46 C   =================================================================
  47 C   >>>   SPECIAL                                                 <<<
  48 C   =================================================================
  49       DO 10 I=1,NNSP
  50         READ(NALFL)
  51    10 CONTINUE
  52 C
  53 C   =================================================================
  54 C   >>>   PS                                                      <<<
  55 C   =================================================================
  56    30 CALL REDDAT
  57      I(NALFL ,
  58      O IDATE , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  59      O PS    , IRTN  ,
  60      I IMD   , JMD   , 1     ,
  61      W BASE  , AMP   , IDA   )
  62       IF(.NOT.(LEVEL.EQ.'SURF'.AND.ELEM.EQ.'P   ')) GOTO 30
  63 C
  64 C   =================================================================
  65 C   >>>   U                                                       <<<
  66 C   =================================================================
  67       DO 110 K=1,KMAX
  68   100 CALL REDDAT
  69      I(NALFL ,
  70      O IDATE , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  71      O GU(1,K), IRTN  ,
  72      I IMD   , JMD   , 1     ,
  73      W BASE  , AMP   , IDA   )
  74       IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'U   ') GOTO 100
  75   110 CONTINUE
  76 C   =================================================================
  77 C   >>>   V                                                       <<<
  78 C   =================================================================
  79       DO 210 K=1,KMAX
  80   200 CALL REDDAT
  81      I(NALFL ,
  82      O IDATE , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  83      O GV(1,K), IRTN  ,
  84      I IMD   , JMD   , 1     ,
  85      W BASE  , AMP   , IDA   )
  86       IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'V   ') GOTO 200
  87   210 CONTINUE
  88 C   =================================================================
  89 C   >>>   Z                                                       <<<
  90 C   =================================================================
  91       DO 310 K=1,KMAX
  92   300 CALL REDDAT
  93      I(NALFL ,
  94      O IDATE , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
  95      O GZ(1,K), IRTN  ,
  96      I IMD   , JMD   , 1     ,
  97      W BASE  , AMP   , IDA   )
  98       IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'Z   ') GOTO 300
  99   310 CONTINUE
 100 C   =================================================================
 101 C   >>>   T                                                       <<<
 102 C   =================================================================
 103       DO 320 K=1,KMAX
 104   330 CALL REDDAT
 105      I(NALFL ,
 106      O IDATE , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
 107      O GT(1,K), IRTN  ,
 108      I IMD   , JMD   , 1     ,
 109      W BASE  , AMP   , IDA   )
 110       IF(LEVEL.EQ.'SURF'.OR.ELEM.NE.'T   ') GOTO 330
 111   320 CONTINUE
 112 C   =================================================================
 113 C   >>>   RH, Q                                                   <<<
 114 C   =================================================================
 115       LARHM=1
 116       DO 410 K=1,KMAX
 117   400 CALL REDDAT
 118      I(NALFL ,
 119      O IDATE , KT    , LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
 120      O GQ(1,K), IRTN  ,
 121      I IMD   , JMD   , 1     ,
 122      W BASE  , AMP   , IDA   )
 123       IF(LEVEL.EQ.'SURF'.OR.(ELEM.NE.'RH  '.AND.ELEM.NE.'Q   '))
 124      1  GOTO 400
 125       IF(ELEM.EQ.'RH  ') LARHM=LARHM+1
 126   410 CONTINUE
 127 C
 128       WRITE(6,*) '## READ ANAL-ETA NORMAL END'
 129       RETURN
 130       END SUBROUTINE REDANL