updated top-level README and version_decl for V4.4.2 (#1795)
[WRF.git] / external / io_grib2 / g2lib / gribinfo.F
blob68751b18a8ae99e37cb3ace542c087e5c2377c5d
1       subroutine gribinfo(cgrib,lcgrib,listsec0,listsec1,
2      &                    numlocal,numfields,maxvals,ierr)
3 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
4 !                .      .    .                                       .
5 ! SUBPROGRAM:    gribinfo 
6 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-25
8 ! ABSTRACT: This subroutine searches through a GRIB2 message and
9 !   returns the number of Local Use Sections and number of gridded
10 !   fields found in the message.  It also performs various checks 
11 !   to see if the message is a valid GRIB2 message.
12 !   Last, a list of safe array dimensions is returned for use in 
13 !   allocating return arrays from routines getlocal, gettemplates, and 
14 !   getfields.  (See maxvals and REMARKS)
16 ! PROGRAM HISTORY LOG:
17 ! 2000-05-25  Gilbert
19 ! USAGE:    CALL gribinfo(cgrib,lcgrib,listsec0,listsec1,
20 !     &                    numlocal,numfields,ierr)
21 !   INPUT ARGUMENT LIST:
22 !     cgrib    - Character array that contains the GRIB2 message
23 !     lcgrib   - Length (in bytes) of GRIB message in array cgrib.
25 !   OUTPUT ARGUMENT LIST:      
26 !     listsec0 - Contains information decoded from GRIB Indicator Section 0.
27 !                Must be dimensioned >= 2.
28 !                listsec0(1)=Discipline-GRIB Master Table Number
29 !                            (see Code Table 0.0)
30 !                listsec0(2)=GRIB Edition Number (currently 2)
31 !                listsec0(3)=Length of GRIB message
32 !     listsec1 - Contains information read from GRIB Identification Section 1.
33 !                Must be dimensioned >= 13.
34 !                listsec1(1)=Id of orginating centre (Common Code Table C-1)
35 !                listsec1(2)=Id of orginating sub-centre (local table)
36 !                listsec1(3)=GRIB Master Tables Version Number (Code Table 1.0)
37 !                listsec1(4)=GRIB Local Tables Version Number 
38 !                listsec1(5)=Significance of Reference Time (Code Table 1.1)
39 !                listsec1(6)=Reference Time - Year (4 digits)
40 !                listsec1(7)=Reference Time - Month
41 !                listsec1(8)=Reference Time - Day
42 !                listsec1(9)=Reference Time - Hour
43 !                listsec1(10)=Reference Time - Minute
44 !                listsec1(11)=Reference Time - Second
45 !                listsec1(12)=Production status of data (Code Table 1.2)
46 !                listsec1(13)=Type of processed data (Code Table 1.3)
47 !     numlocal - The number of Local Use Sections ( Section 2 ) found in 
48 !                the GRIB message.
49 !     numfields- The number of gridded fieldse found in the GRIB message.
50 !     maxvals()- The maximum number of elements that could be returned
51 !                in various arrays from this GRIB2 message. (see REMARKS)
52 !                maxvals(1)=max length of local section 2 (for getlocal)
53 !                maxvals(2)=max length of GDS Template (for gettemplates 
54 !                                                       and getfield)
55 !                maxvals(3)=max length of GDS Optional list (for getfield)
56 !                maxvals(4)=max length of PDS Template (for gettemplates 
57 !                                                       and getfield)
58 !                maxvals(5)=max length of PDS Optional list (for getfield)
59 !                maxvals(6)=max length of DRS Template (for gettemplates 
60 !                                                       and getfield)
61 !                maxvals(7)=max number of gridpoints (for getfield)
62 !     ierr     - Error return code.
63 !                0 = no error
64 !                1 = Beginning characters "GRIB" not found.
65 !                2 = GRIB message is not Edition 2.
66 !                3 = Could not find Section 1, where expected.
67 !                4 = End string "7777" found, but not where expected.
68 !                5 = End string "7777" not found at end of message.
70 ! REMARKS: Array maxvals contains the maximum possible 
71 !          number of values that will be returned in argument arrays
72 !          for routines getlocal, gettemplates, and getfields.  
73 !          Users can use this info to determine if their arrays are 
74 !          dimensioned large enough for the data that may be returned
75 !          from the above routines, or to dynamically allocate arrays
76 !          with a reasonable size.
77 !          NOTE that the actual number of values in these arrays is returned
78 !          from the routines and will likely be less than the values 
79 !          calculated by this routine.
81 ! ATTRIBUTES:
82 !   LANGUAGE: Fortran 90
83 !   MACHINE:  IBM SP
85 !$$$
87       character(len=1),intent(in) :: cgrib(lcgrib)
88       integer,intent(in) :: lcgrib
89       integer,intent(out) :: listsec0(3),listsec1(13),maxvals(7)
90       integer,intent(out) :: numlocal,numfields,ierr
91       
92       character(len=4),parameter :: grib='GRIB',c7777='7777'
93       character(len=4) :: ctemp
94       integer,parameter :: zero=0,one=1
95       integer,parameter :: mapsec1len=13
96       integer,parameter :: 
97      &        mapsec1(mapsec1len)=(/ 2,2,1,1,1,2,1,1,1,1,1,1,1 /)
98       integer iofst,ibeg,istart
100       ierr=0
101       numlocal=0
102       numfields=0
103       maxsec2len=1
104       maxgdstmpl=1
105       maxdeflist=1
106       maxpdstmpl=1
107       maxcoordlist=1
108       maxdrstmpl=1
109       maxgridpts=0
111 !  Check for beginning of GRIB message in the first 100 bytes
113       istart=0
114       do j=1,100
115         ctemp=cgrib(j)//cgrib(j+1)//cgrib(j+2)//cgrib(j+3)
116         if (ctemp.eq.grib ) then
117           istart=j
118           exit
119         endif
120       enddo
121       if (istart.eq.0) then
122         print *,'gribinfo:  Beginning characters GRIB not found.'
123         ierr=1
124         return
125       endif
127 !  Unpack Section 0 - Indicator Section 
129       iofst=8*(istart+5)
130       call g2lib_gbyte(cgrib,listsec0(1),iofst,8)     ! Discipline
131       iofst=iofst+8
132       call g2lib_gbyte(cgrib,listsec0(2),iofst,8)     ! GRIB edition number
133       iofst=iofst+8
134       iofst=iofst+32
135       call g2lib_gbyte(cgrib,lengrib,iofst,32)        ! Length of GRIB message
136       iofst=iofst+32
137       listsec0(3)=lengrib
138       lensec0=16
139       ipos=istart+lensec0
141 !  Currently handles only GRIB Edition 2.
142 !  
143       if (listsec0(2).ne.2) then
144         print *,'gribinfo: can only decode GRIB edition 2.'
145         ierr=2
146         return
147       endif
149 !  Unpack Section 1 - Identification Section
151       call g2lib_gbyte(cgrib,lensec1,iofst,32)        ! Length of Section 1
152       iofst=iofst+32
153       call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Section number ( 1 )
154       iofst=iofst+8
155       if (isecnum.ne.1) then
156         print *,'gribinfo: Could not find section 1.'
157         ierr=3
158         return
159       endif
160       !
161       !   Unpack each input value in array listsec1 into the
162       !   the appropriate number of octets, which are specified in
163       !   corresponding entries in array mapsec1.
164       !
165       do i=1,mapsec1len
166         nbits=mapsec1(i)*8
167         call g2lib_gbyte(cgrib,listsec1(i),iofst,nbits)
168         iofst=iofst+nbits
169       enddo
170       ipos=ipos+lensec1
172 !  Loop through the remaining sections keeping track of the 
173 !  length of each.  Also count the number of times Section 2
174 !  and Section 4 appear.
176       do
177         ctemp=cgrib(ipos)//cgrib(ipos+1)//cgrib(ipos+2)//cgrib(ipos+3)
178         if (ctemp.eq.c7777 ) then
179           ipos=ipos+4
180           if (ipos.ne.(istart+lengrib)) then
181             print *,'gribinfo: "7777" found, but not where expected.'
182             ierr=4
183             return
184           endif
185           exit
186         endif
187         iofst=(ipos-1)*8
188         call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
189         iofst=iofst+32
190         call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section number
191         iofst=iofst+8
192         ipos=ipos+lensec                 ! Update beginning of section pointer
193         if (ipos.gt.(istart+lengrib)) then
194           print *,'gribinfo: "7777"  not found at end of GRIB message.'
195           ierr=5
196           return
197         endif
198         if (isecnum.eq.2) then     ! Local Section 2
199            !   increment counter for total number of local sections found
200            !   and determine largest Section 2 in message
201            numlocal=numlocal+1
202            lenposs=lensec-5
203            if ( lenposs.gt.maxsec2len ) maxsec2len=lenposs
204         elseif (isecnum.eq.3) then
205            iofst=iofst+8                      ! skip source of grid def.
206            call g2lib_gbyte(cgrib,ngdpts,iofst,32)         ! Get Num of Grid Points
207            iofst=iofst+32
208            call g2lib_gbyte(cgrib,nbyte,iofst,8)      ! Get Num octets for opt. list
209            iofst=iofst+8
210            if (ngdpts.gt.maxgridpts) maxgridpts=ngdpts
211            lenposs=lensec-14
212            if ( lenposs.gt.maxgdstmpl ) maxgdstmpl=lenposs
213            if (nbyte.ne.0) then
214               lenposs=lenposs/nbyte
215               if ( lenposs.gt.maxdeflist ) maxdeflist=lenposs
216            endif
217         elseif (isecnum.eq.4) then
218           numfields=numfields+1
219            call g2lib_gbyte(cgrib,numcoord,iofst,16)      ! Get Num of Coord Values
220            iofst=iofst+16
221            if (numcoord.ne.0) then
222               if (numcoord.gt.maxcoordlist) maxcoordlist=numcoord
223            endif
224            lenposs=lensec-9
225            if ( lenposs.gt.maxpdstmpl ) maxpdstmpl=lenposs
226         elseif (isecnum.eq.5) then
227            lenposs=lensec-11
228            if ( lenposs.gt.maxdrstmpl ) maxdrstmpl=lenposs
229         endif
230         
231       enddo
233       maxvals(1)=maxsec2len
234       maxvals(2)=maxgdstmpl
235       maxvals(3)=maxdeflist
236       maxvals(4)=maxpdstmpl
237       maxvals(5)=maxcoordlist
238       maxvals(6)=maxdrstmpl
239       maxvals(7)=maxgridpts
241       return
242       end