1 C-----------------------------------------------------------------------
2 SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
3 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
5 C SUBPROGRAM: IXGB2 MAKE INDEX RECORDS FOR FIELDS IN A GRIB2 MESSAGE
6 C PRGMMR: GILBERT ORG: W/NP11 DATE: 2001-12-10
8 C ABSTRACT: THIS SUBPROGRAM GENERATES AN INDEX RECORD FOR EACH FIELD IN A
9 C GRIB2 MESSAGE. THE INDEX RECORDS ARE WRITTEN TO INDEX BUFFER
12 C EACH INDEX RECORD HAS THE FOLLOWING FORM:
13 C BYTE 001 - 004: LENGTH OF INDEX RECORD
14 C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
15 C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
16 C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
17 C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
18 C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
19 C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
20 C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
21 C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
22 C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
23 C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
24 C BYTE 042 - 042: MESSAGE DISCIPLINE
25 C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
26 C BYTE 045 - II: IDENTIFICATION SECTION (IDS)
27 C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
28 C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
29 C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
30 C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
32 C PROGRAM HISTORY LOG:
34 C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
35 C 2001-12-10 GILBERT MODIFIED FROM IXGB TO CREATE GRIB2 INDEXES
36 C 2002-01-31 GILBERT ADDED IDENTIFICATION SECTION TO INDEX RECORD
38 C USAGE: CALL IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
40 C LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE
41 C LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE
42 C LGRIB INTEGER NUMBER OF BYTES IN GRIB MESSAGE
44 C CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
45 C USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
46 C USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
47 C NUMFLD INTEGER NUMBER OF INDEX RECORDS CREATED.
49 C MLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
50 C IRET INTEGER RETURN CODE
52 C =1, NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
53 C =2, I/O ERROR IN READ
54 C =3, GRIB MESSAGE IS NOT EDITION 2
55 C =4, NOT ENOUGH MEMORY TO ALLOCATE EXTENT TO INDEX BUFFER
56 C =5, UNIDENTIFIED GRIB SECTION ENCOUNTERED...PROBLEM
60 C G2LIB_GBYTE GET INTEGER DATA FROM BYTES
61 C G2LIB_SBYTE STORE INTEGER DATA IN BYTES
62 C BAREAD BYTE-ADDRESSABLE READ
63 C REALLOC RE-ALLOCATES MORE MEMORY
66 C LANGUAGE: FORTRAN 90
69 USE RE_ALLOC ! NEEDED FOR SUBROUTINE REALLOC
70 CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
71 PARAMETER(LINMAX=5000,INIT=50000,NEXT=10000)
72 PARAMETER(IXSKP=4,IXLUS=8,IXSGD=12,IXSPD=16,IXSDR=20,IXSBM=24,
73 & IXDS=28,IXLEN=36,IXFLD=42,IXIDS=44)
74 PARAMETER(MXSKP=4,MXLUS=4,MXSGD=4,MXSPD=4,MXSDR=4,MXSBM=4,
75 & MXDS=4,MXLEN=4,MXFLD=2,MXBMS=6)
76 CHARACTER CBREAD(LINMAX),CINDEX(LINMAX)
78 CHARACTER CIDS(LINMAX),CGDS(LINMAX),CBMS(6)
79 CHARACTER(LEN=4) :: CTEMP
80 INTEGER LOCLUS,LOCGDS,LENGDS,LOCBMS
81 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
86 IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
88 ALLOCATE(CBUF(MBUF),STAT=ISTAT) ! ALLOCATE INITIAL SPACE FOR CBUF
93 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
94 C READ SECTIONS 0 AND 1 FOR VERSIN NUMBER AND DISCIPLINE
95 IBREAD=MIN(LGRIB,LINMAX)
96 CALL BAREAD(LUGB,LSKIP,IBREAD,LBREAD,CBREAD)
97 IF(LBREAD.NE.IBREAD) THEN
101 IF(CBREAD(8).NE.CHAR(2)) THEN ! NOT GRIB EDITION 2
107 CALL G2LIB_GBYTE(CBREAD,LENSEC1,16*8,4*8)
108 LENSEC1=MIN(LENSEC1,IBREAD)
109 CIDS(1:LENSEC1)=CBREAD(17:16+LENSEC1)
110 IBSKIP=LSKIP+16+LENSEC1
111 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
112 C LOOP THROUGH REMAINING SECTIONS CREATING AN INDEX FOR EACH FIELD
115 CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
116 CTEMP=CBREAD(1)//CBREAD(2)//CBREAD(3)//CBREAD(4)
117 IF (CTEMP.EQ.'7777') RETURN ! END OF MESSAGE FOUND
118 IF(LBREAD.NE.IBREAD) THEN
122 CALL G2LIB_GBYTE(CBREAD,LENSEC,0*8,4*8)
123 CALL G2LIB_GBYTE(CBREAD,NUMSEC,4*8,1*8)
125 IF (NUMSEC.EQ.2) THEN ! SAVE LOCAL USE LOCATION
127 ELSEIF (NUMSEC.EQ.3) THEN ! SAVE GDS INFO
130 CALL BAREAD(LUGB,IBSKIP,LENGDS,LBREAD,CGDS)
131 IF(LBREAD.NE.LENGDS) THEN
136 ELSEIF (NUMSEC.EQ.4) THEN ! FOUND PDS
138 CALL G2LIB_SBYTE(CINDEX,LSKIP,8*IXSKP,8*MXSKP) ! BYTES TO SKIP
139 CALL G2LIB_SBYTE(CINDEX,LOCLUS,8*IXLUS,8*MXLUS) ! LOCATION OF LOCAL USE
140 CALL G2LIB_SBYTE(CINDEX,LOCGDS,8*IXSGD,8*MXSGD) ! LOCATION OF GDS
141 CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSPD,8*MXSPD) ! LOCATION OF PDS
142 CALL G2LIB_SBYTE(CINDEX,LGRIB,8*IXLEN,8*MXLEN) ! LEN OF GRIB2
145 CALL G2LIB_SBYTE(CINDEX,NUMFLD+1,8*IXFLD,8*MXFLD) ! FIELD NUM
146 CINDEX(IXIDS+1:IXIDS+LENSEC1)=CIDS(1:LENSEC1)
148 CINDEX(LINDEX+1:LINDEX+LENGDS)=CGDS(1:LENGDS)
151 CALL BAREAD(LUGB,IBSKIP,ILNPDS,LBREAD,CINDEX(LINDEX+1))
152 IF(LBREAD.NE.ILNPDS) THEN
156 ! CINDEX(LINDEX+1:LINDEX+ILNPDS)=CBREAD(1:ILNPDS)
158 ELSEIF (NUMSEC.EQ.5) THEN ! FOUND DRS
159 CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSDR,8*MXSDR) ! LOCATION OF DRS
161 CALL BAREAD(LUGB,IBSKIP,ILNDRS,LBREAD,CINDEX(LINDEX+1))
162 IF(LBREAD.NE.ILNDRS) THEN
166 ! CINDEX(LINDEX+1:LINDEX+ILNDRS)=CBREAD(1:ILNDRS)
168 ELSEIF (NUMSEC.EQ.6) THEN ! FOUND BMS
169 INDBMP=MOVA2I(CBREAD(6))
170 IF ( INDBMP.LT.254 ) THEN
172 CALL G2LIB_SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM) ! LOC. OF BMS
173 ELSEIF ( INDBMP.EQ.254 ) THEN
174 CALL G2LIB_SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM) ! LOC. OF BMS
175 ELSEIF ( INDBMP.EQ.255 ) THEN
176 CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSBM,8*MXSBM) ! LOC. OF BMS
178 CINDEX(LINDEX+1:LINDEX+MXBMS)=CBREAD(1:MXBMS)
180 CALL G2LIB_SBYTE(CINDEX,LINDEX,0,8*4) ! NUM BYTES IN INDEX RECORD
181 ELSEIF (NUMSEC.EQ.7) THEN ! FOUND DATA SECTION
182 CALL G2LIB_SBYTE(CINDEX,IBSKIP-LSKIP,8*IXDS,8*MXDS) ! LOC. OF DATA SEC.
184 IF ((LINDEX+MLEN).GT.MBUF) THEN ! ALLOCATE MORE SPACE IF
186 NEWSIZE=MAX(MBUF+NEXT,MBUF+LINDEX)
187 CALL REALLOC(CBUF,MLEN,NEWSIZE,ISTAT)
188 IF ( ISTAT .NE. 0 ) THEN
195 CBUF(MLEN+1:MLEN+LINDEX)=CINDEX(1:LINDEX)
197 ELSE ! UNRECOGNIZED SECTION
204 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -