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