hwrf-baseline-20120103-1354/ungrib/src/ngl/g2/getidx.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: GETIDX         FINDS, READS OR GENERATES A GRIB2 INDEX
   6 C   PRGMMR: GILBERT          ORG: W/NP11     DATE: 2005-03-15
   7 C
   8 C ABSTRACT: FINDS, READS OR GENERATES A GRIB2 INDEX FOR THE GRIB2 FILE
   9 C  ASSOCIATED WITH UNIT LUGB.  IF THE INDEX ALREADY EXISTS, IT IS RETURNED.
  10 C  OTHERWISE, THE INDEX IS (1) READ FROM AN EXISTING INDEXFILE ASSOCIATED WITH
  11 C  UNIT LUGI. OR (2) GENERATED FROM THE GRIB2FILE LUGB ( IF LUGI=0 ).
  12 C  USERS CAN FORCE A REGENERATION OF AN INDEX.  IF LUGI EQUALS LUGB, THE INDEX
  13 C  WILL BE REGENERATED FROM THE DATA IN FILE LUGB.  IF LUGI IS LESS THAN
  14 C  ZERO, THEN THE INDEX IS RE READ FROM INDEX FILE ABS(LUGI).
  15 C
  16 C PROGRAM HISTORY LOG:
  17 C 2005-03-15  GILBERT
  18 C 2009-07-09  VUONG      Fixed bug for checking (LUGB) unit index file
  19 C
  20 C USAGE:    CALL GETIDX(LUGB,LUGI,CINDEX,NLEN,NNUM,IRET)
  21 C
  22 C   INPUT ARGUMENTS:
  23 C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE.
  24 C                  FILE MUST BE OPENED WITH BAOPEN OR BAOPENR BEFORE CALLING
  25 C                  THIS ROUTINE.
  26 C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE.
  27 C                  IF NONZERO, FILE MUST BE OPENED WITH BAOPEN BAOPENR BEFORE
  28 C                  CALLING THIS ROUTINE.
  29 C                  >0 - READ INDEX FROM INDEX FILE LUGI, IF INDEX DOESN"T
  30 C                       ALREADY EXIST.
  31 C                  =0 - TO GET INDEX BUFFER FROM THE GRIB FILE, IF INDEX
  32 C                       DOESN"T ALREADY EXIST.
  33 C                  <0 - FORCE REREAD OF INDEX FROM INDEX FILE ABS(LUGI).
  34 C                  =LUGB - FORCE REGENERATION OF INDEX FROM GRIB2 FILE LUGB.
  35 C
  36 C   OUTPUT ARGUMENTS:
  37 C     CINDEX       CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
  38 C     NLEN         INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
  39 C     NNUM         INTEGER NUMBER OF INDEX RECORDS
  40 C     IRET         INTEGER RETURN CODE
  41 C                    0      ALL OK
  42 C                    90     UNIT NUMBER OUT OF RANGE
  43 C                    96     ERROR READING/CREATING INDEX FILE
  44 C
  45 C SUBPROGRAMS CALLED:
  46 C   GETG2I          READ INDEX FILE
  47 C   GETG2IR         READ INDEX BUFFER FROM GRIB FILE
  48 C
  49 C REMARKS:
  50 C
  51 C
  52 C ATTRIBUTES:
  53 C   LANGUAGE: FORTRAN 90
  54 C
  55 C$$$
  56
  57       INTEGER,INTENT(IN) :: LUGB,LUGI
  58       INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
  59       CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CINDEX
  60
  61       INTEGER,PARAMETER :: MAXIDX=100
  62       INTEGER,PARAMETER :: MSK1=32000,MSK2=4000
  63
  64       TYPE GINDEX
  65          integer :: nlen
  66          integer :: nnum
  67          character(len=1),pointer,dimension(:) :: cbuf
  68       END TYPE GINDEX
  69
  70       TYPE(GINDEX),SAVE :: IDXLIST(100)
  71
  72       DATA LUX/0/
  73 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  74 C  DECLARE INTERFACES (REQUIRED FOR CBUF POINTER)
  75       INTERFACE
  76          SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
  77             CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
  78             INTEGER,INTENT(IN) :: LUGI
  79             INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
  80          END SUBROUTINE GETG2I
  81          SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,
  82      &                      NMESS,IRET)
  83             CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
  84             INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM
  85             INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET
  86          END SUBROUTINE GETG2IR
  87       END INTERFACE
  88
  89 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  90 C  DETERMINE WHETHER INDEX BUFFER NEEDS TO BE INITIALIZED
  91       LUX=0
  92       IRET=0
  93       IF ( LUGB.LE.0 .OR. LUGB.GT.100 ) THEN
  94          IRET=90
  95          RETURN
  96       ENDIF
  97       IF (LUGI.EQ.LUGB) THEN      ! Force regeneration of index from GRIB2 File
  98          IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) )
  99      &                  DEALLOCATE(IDXLIST(LUGB)%CBUF)
 100          NULLIFY(IDXLIST(LUGB)%CBUF)
 101          IDXLIST(LUGB)%NLEN=0
 102          IDXLIST(LUGB)%NNUM=0
 103          LUX=0
 104       ENDIF
 105       IF (LUGI.LT.0) THEN      ! Force re-read of index from indexfile
 106                                ! associated with unit abs(lugi)
 107          IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) )
 108      &                  DEALLOCATE(IDXLIST(LUGB)%CBUF)
 109          NULLIFY(IDXLIST(LUGB)%CBUF)
 110          IDXLIST(LUGB)%NLEN=0
 111          IDXLIST(LUGB)%NNUM=0
 112          LUX=ABS(LUGI)
 113       ENDIF
 114 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 115 C  Check if index already exists in memory
 116       IF ( ASSOCIATED( IDXLIST(LUGB)%CBUF ) ) THEN
 117          CINDEX => IDXLIST(LUGB)%CBUF
 118          NLEN = IDXLIST(LUGB)%NLEN
 119          NNUM = IDXLIST(LUGB)%NNUM
 120          RETURN
 121       ENDIF
 122 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 123       IRGI=0
 124       IF(LUX.GT.0) THEN
 125         CALL GETG2I(LUX,IDXLIST(LUGB)%CBUF,NLEN,NNUM,IRGI)
 126       ELSEIF(LUX.LE.0) THEN
 127         MSKP=0
 128         CALL GETG2IR(LUGB,MSK1,MSK2,MSKP,IDXLIST(LUGB)%CBUF,
 129      &               NLEN,NNUM,NMESS,IRGI)
 130       ENDIF
 131       IF(IRGI.EQ.0) THEN
 132          CINDEX => IDXLIST(LUGB)%CBUF
 133          IDXLIST(LUGB)%NLEN = NLEN
 134          IDXLIST(LUGB)%NNUM = NNUM
 135       ELSE
 136          NLEN = 0
 137          NNUM = 0
 138          IRET=96
 139          RETURN
 140       ENDIF
 141 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 142 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 143       RETURN
 144       END