var/convertor/wave2grid_kma/REDDAT.inc

   1       SUBROUTINE REDDAT
   2      I(NFL   ,
   3      O IDATE , KT    ,
   4      O LEVEL , ELEM  , TITLE , UNIT  , KTSD  , KTSA  ,
   5      O DATA  , IRTN  ,
   6      I IDIM  , JDIM  , KMAX  ,
   7      W BASE  , AMP   ,IDA   )
   8 C
   9       INTEGER IDATE(5)
  10       CHARACTER* 4 LEVEL, ELEM
  11       CHARACTER*32 TITLE
  12       CHARACTER*16 UNIT
  13       INTEGER KTSD, KTSA
  14       DIMENSION DATA(IDIM*JDIM)
  15 c     INTEGER*2 IDA(IDIM*JDIM)    !shc-rizvi
  16       INTEGER   IDA(IDIM*JDIM/2)  !shc-rizvi
  17 C
  18       INTEGER IDNEXT(5)
  19 C
  20       READ (NFL,END=999,ERR=999) IDATE, KT, NELM, LEVEL, ELEM
  21       IF( NELM.GT.1 ) THEN
  22         WRITE(96,*) 'REDDAT:NELM.GT.1'
  23         WRITE(96,*) 'REDDAT:NELM=', NELM
  24         STOP 999
  25       ELSE IF( NELM.EQ.0 ) THEN
  26 C     ---------------------------------------------------------------
  27 C     >>>   DD ˜AŒ‹‘Î‰ž‚Ì‚Â‚à‚è                                   <<<
  28 C     ---------------------------------------------------------------
  29         READ(NFL,END=998,ERR=998)
  30      1           NNSP, IDNEXT, NNSP, NNSP, NNSP, NNSP, NNSP, NNSP,
  31      2           NNSP, NNSP, NNSP, NNSP, NNSP
  32         IF(IDATE(1).NE.IDNEXT(1).OR.IDATE(2).NE.IDNEXT(2)
  33      1   .OR.IDATE(3).NE.IDNEXT(3).OR.IDATE(4).NE.IDNEXT(4)) THEN
  34           WRITE(96,*) '## INVALID DD CONNECTION'
  35           WRITE(96,*) IDATE
  36           WRITE(96,*) IDNEXT
  37           GOTO 998
  38         ENDIF
  39           WRITE(96,*) '## VALID DD CONNECTION'
  40         READ(NFL)
  41         READ(NFL)
  42         READ(NFL)
  43         READ(NFL)
  44         READ(NFL)
  45         DO 10 I=1,NNSP
  46           READ(NFL)
  47    10   CONTINUE
  48         READ (NFL,END=999,ERR=999) IDATE, KT, NELM, LEVEL, ELEM
  49       ENDIF
  50 C
  51     1 READ (NFL,END=999,ERR=999)
  52      1  LEVEL, ELEM, TITLE, UNIT,
  53      2  KTSD, KTSA, BASE, AMP,
  54      3  (IDA(I),I=1,IDIM*JDIM)
  55       CALL CI2R4V(DATA,BASE,AMP,IDA,IDIM*JDIM)
  56 CC    DO 10 I=1,IDIM*JDIM
  57 CC      DATA(I)=BASE + AMP*IDA(I)
  58 CC 10 CONTINUE
  59 C
  60       IRTN=0
  61       RETURN
  62 C
  63   998 IRTN=-1
  64       RETURN
  65 C
  66   999 WRITE(96,*) 'REDDAT: READ ERROR IN FILE',NFL
  67       STOP 999
  68 C
  69       END SUBROUTINE REDDAT
  70