1 | subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, |
---|
2 | & mapgridlen,ideflist,idefnum,ierr) |
---|
3 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
---|
4 | ! . . . . |
---|
5 | ! SUBPROGRAM: gf_unpack3 |
---|
6 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 |
---|
7 | ! |
---|
8 | ! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section) |
---|
9 | ! starting at octet 6 of that Section. |
---|
10 | ! |
---|
11 | ! PROGRAM HISTORY LOG: |
---|
12 | ! 2000-05-26 Gilbert |
---|
13 | ! 2002-01-24 Gilbert - Changed to dynamically allocate arrays |
---|
14 | ! and to pass pointers to those arrays through |
---|
15 | ! the argument list. |
---|
16 | ! |
---|
17 | ! USAGE: CALL gf_unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl, |
---|
18 | ! & mapgridlen,ideflist,idefnum,ierr) |
---|
19 | ! INPUT ARGUMENT LIST: |
---|
20 | ! cgrib - Character array that contains the GRIB2 message |
---|
21 | ! lcgrib - Length (in bytes) of GRIB message array cgrib. |
---|
22 | ! iofst - Bit offset of the beginning of Section 3. |
---|
23 | ! |
---|
24 | ! OUTPUT ARGUMENT LIST: |
---|
25 | ! iofst - Bit offset at the end of Section 3, returned. |
---|
26 | ! igds - Contains information read from the appropriate GRIB Grid |
---|
27 | ! Definition Section 3 for the field being returned. |
---|
28 | ! Must be dimensioned >= 5. |
---|
29 | ! igds(1)=Source of grid definition (see Code Table 3.0) |
---|
30 | ! igds(2)=Number of grid points in the defined grid. |
---|
31 | ! igds(3)=Number of octets needed for each |
---|
32 | ! additional grid points definition. |
---|
33 | ! Used to define number of |
---|
34 | ! points in each row ( or column ) for |
---|
35 | ! non-regular grids. |
---|
36 | ! = 0, if using regular grid. |
---|
37 | ! igds(4)=Interpretation of list for optional points |
---|
38 | ! definition. (Code Table 3.11) |
---|
39 | ! igds(5)=Grid Definition Template Number (Code Table 3.1) |
---|
40 | ! igdstmpl - Pointer to integer array containing the data values for |
---|
41 | ! the specified Grid Definition |
---|
42 | ! Template ( NN=igds(5) ). Each element of this integer |
---|
43 | ! array contains an entry (in the order specified) of Grid |
---|
44 | ! Defintion Template 3.NN |
---|
45 | ! mapgridlen- Number of elements in igdstmpl(). i.e. number of entries |
---|
46 | ! in Grid Defintion Template 3.NN ( NN=igds(5) ). |
---|
47 | ! ideflist - (Used if igds(3) .ne. 0) Pointer to integer array containing |
---|
48 | ! the number of grid points contained in each row ( or column ). |
---|
49 | ! (part of Section 3) |
---|
50 | ! idefnum - (Used if igds(3) .ne. 0) The number of entries |
---|
51 | ! in array ideflist. i.e. number of rows ( or columns ) |
---|
52 | ! for which optional grid points are defined. |
---|
53 | ! ierr - Error return code. |
---|
54 | ! 0 = no error |
---|
55 | ! 5 = "GRIB" message contains an undefined Grid Definition |
---|
56 | ! Template. |
---|
57 | ! 6 = memory allocation error |
---|
58 | ! |
---|
59 | ! REMARKS: Uses Fortran 90 module gridtemplates and module re_alloc. |
---|
60 | ! |
---|
61 | ! ATTRIBUTES: |
---|
62 | ! LANGUAGE: Fortran 90 |
---|
63 | ! MACHINE: IBM SP |
---|
64 | ! |
---|
65 | !$$$ |
---|
66 | |
---|
67 | use gridtemplates |
---|
68 | use re_alloc ! needed for subroutine realloc |
---|
69 | |
---|
70 | character(len=1),intent(in) :: cgrib(lcgrib) |
---|
71 | integer,intent(in) :: lcgrib |
---|
72 | integer,intent(inout) :: iofst |
---|
73 | integer,pointer,dimension(:) :: igdstmpl,ideflist |
---|
74 | integer,intent(out) :: igds(5) |
---|
75 | integer,intent(out) :: ierr,idefnum |
---|
76 | |
---|
77 | integer,allocatable :: mapgrid(:) |
---|
78 | integer :: mapgridlen,ibyttem |
---|
79 | logical needext |
---|
80 | |
---|
81 | ierr=0 |
---|
82 | nullify(igdstmpl,ideflist) |
---|
83 | |
---|
84 | call g2lib_gbyte(cgrib,lensec,iofst,32) ! Get Length of Section |
---|
85 | iofst=iofst+32 |
---|
86 | iofst=iofst+8 ! skip section number |
---|
87 | |
---|
88 | call g2lib_gbyte(cgrib,igds(1),iofst,8) ! Get source of Grid def. |
---|
89 | iofst=iofst+8 |
---|
90 | call g2lib_gbyte(cgrib,igds(2),iofst,32) ! Get number of grid pts. |
---|
91 | iofst=iofst+32 |
---|
92 | call g2lib_gbyte(cgrib,igds(3),iofst,8) ! Get num octets for opt. list |
---|
93 | iofst=iofst+8 |
---|
94 | call g2lib_gbyte(cgrib,igds(4),iofst,8) ! Get interpret. for opt. list |
---|
95 | iofst=iofst+8 |
---|
96 | call g2lib_gbyte(cgrib,igds(5),iofst,16) ! Get Grid Def Template num. |
---|
97 | iofst=iofst+16 |
---|
98 | ! if (igds(1).eq.0) then |
---|
99 | if (igds(1).eq.0.OR.igds(1).eq.255) then ! FOR ECMWF TEST ONLY |
---|
100 | allocate(mapgrid(lensec)) |
---|
101 | ! Get Grid Definition Template |
---|
102 | call getgridtemplate(igds(5),mapgridlen,mapgrid,needext, |
---|
103 | & iret) |
---|
104 | if (iret.ne.0) then |
---|
105 | ierr=5 |
---|
106 | if( allocated(mapgrid) ) deallocate(mapgrid) |
---|
107 | return |
---|
108 | endif |
---|
109 | else |
---|
110 | ! igdstmpl=-1 |
---|
111 | mapgridlen=0 |
---|
112 | needext=.false. |
---|
113 | endif |
---|
114 | ! |
---|
115 | ! Unpack each value into array igdstmpl from the |
---|
116 | ! the appropriate number of octets, which are specified in |
---|
117 | ! corresponding entries in array mapgrid. |
---|
118 | ! |
---|
119 | istat=0 |
---|
120 | if (mapgridlen.gt.0) allocate(igdstmpl(mapgridlen),stat=istat) |
---|
121 | if (istat.ne.0) then |
---|
122 | ierr=6 |
---|
123 | nullify(igdstmpl) |
---|
124 | if( allocated(mapgrid) ) deallocate(mapgrid) |
---|
125 | return |
---|
126 | endif |
---|
127 | ibyttem=0 |
---|
128 | do i=1,mapgridlen |
---|
129 | nbits=iabs(mapgrid(i))*8 |
---|
130 | if ( mapgrid(i).ge.0 ) then |
---|
131 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits) |
---|
132 | else |
---|
133 | call g2lib_gbyte(cgrib,isign,iofst,1) |
---|
134 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) |
---|
135 | if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) |
---|
136 | endif |
---|
137 | iofst=iofst+nbits |
---|
138 | ibyttem=ibyttem+iabs(mapgrid(i)) |
---|
139 | enddo |
---|
140 | ! |
---|
141 | ! Check to see if the Grid Definition Template needs to be |
---|
142 | ! extended. |
---|
143 | ! The number of values in a specific template may vary |
---|
144 | ! depending on data specified in the "static" part of the |
---|
145 | ! template. |
---|
146 | ! |
---|
147 | if ( needext ) then |
---|
148 | call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid) |
---|
149 | ! Unpack the rest of the Grid Definition Template |
---|
150 | call realloc(igdstmpl,mapgridlen,newmapgridlen,istat) |
---|
151 | do i=mapgridlen+1,newmapgridlen |
---|
152 | nbits=iabs(mapgrid(i))*8 |
---|
153 | if ( mapgrid(i).ge.0 ) then |
---|
154 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits) |
---|
155 | else |
---|
156 | call g2lib_gbyte(cgrib,isign,iofst,1) |
---|
157 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) |
---|
158 | if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) |
---|
159 | endif |
---|
160 | iofst=iofst+nbits |
---|
161 | ibyttem=ibyttem+iabs(mapgrid(i)) |
---|
162 | enddo |
---|
163 | mapgridlen=newmapgridlen |
---|
164 | endif |
---|
165 | if( allocated(mapgrid) ) deallocate(mapgrid) |
---|
166 | ! |
---|
167 | ! Unpack optional list of numbers defining number of points |
---|
168 | ! in each row or column, if included. This is used for non regular |
---|
169 | ! grids. |
---|
170 | ! |
---|
171 | if ( igds(3).ne.0 ) then |
---|
172 | nbits=igds(3)*8 |
---|
173 | idefnum=(lensec-14-ibyttem)/igds(3) |
---|
174 | istat=0 |
---|
175 | if (idefnum.gt.0) allocate(ideflist(idefnum),stat=istat) |
---|
176 | if (istat.ne.0) then |
---|
177 | ierr=6 |
---|
178 | nullify(ideflist) |
---|
179 | return |
---|
180 | endif |
---|
181 | call g2lib_gbytes(cgrib,ideflist,iofst,nbits,0,idefnum) |
---|
182 | iofst=iofst+(nbits*idefnum) |
---|
183 | else |
---|
184 | idefnum=0 |
---|
185 | nullify(ideflist) |
---|
186 | endif |
---|
187 | |
---|
188 | return ! End of Section 3 processing |
---|
189 | end |
---|