source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/drstemplates.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 9.6 KB
Line 
1      module drstemplates
2!$$$  SUBPROGRAM DOCUMENTATION BLOCK
3!                .      .    .                                       .
4! MODULE:    drstemplates
5!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-04-03
6!
7! ABSTRACT: This Fortran Module contains info on all the available
8!   GRIB2 Data Representation Templates used in Section 5 (DRS).
9!   Each Template has three parts: The number of entries in the template
10!   (mapgridlen);  A map of the template (mapgrid), which contains the
11!   number of octets in which to pack each of the template values; and
12!   a logical value (needext) that indicates whether the Template needs
13!   to be extended.  In some cases the number of entries in a template
14!   can vary depending upon values specified in the "static" part of
15!   the template.  ( See Template 5.1 as an example )
16!
17!   This module also contains two subroutines.  Subroutine getdrstemplate
18!   returns the octet map for a specified Template number, and
19!   subroutine extdrstemplate will calculate the extended octet map
20!   of an appropriate template given values for the "static" part of the
21!   template.  See docblocks below for the arguments and usage of these
22!   routines.
23!
24!   NOTE:  Array mapgrid contains the number of octets in which the
25!   corresponding template values will be stored.  A negative value in
26!   mapgrid is used to indicate that the corresponding template entry can
27!   contain negative values.  This information is used later when packing
28!   (or unpacking) the template data values.  Negative data values in GRIB
29!   are stored with the left most bit set to one, and a negative number
30!   of octets value in mapgrid() indicates that this possibility should
31!   be considered.  The number of octets used to store the data value
32!   in this case would be the absolute value of the negative value in
33!   mapgrid().
34
35!
36! PROGRAM HISTORY LOG:
37! 2000-05-11  Gilbert
38! 2002-12-11  Gilbert - Added templates for JPEG2000 and PNG encoding
39!
40! USAGE:    use drstemplates
41!
42! ATTRIBUTES:
43!   LANGUAGE: Fortran 90
44!   MACHINE:  IBM SP
45!
46!$$$
47
48      integer,parameter :: MAXLEN=200,MAXTEMP=9
49
50      type drstemplate
51          integer :: template_num
52          integer :: mapdrslen
53          integer,dimension(MAXLEN) :: mapdrs
54          logical :: needext
55      end type drstemplate
56
57      type(drstemplate),dimension(MAXTEMP) :: templates
58
59      data templates(1)%template_num /0/     !  Simple Packing
60      data templates(1)%mapdrslen /5/
61      data templates(1)%needext /.false./
62      data (templates(1)%mapdrs(j),j=1,5)
63     &                             /4,-2,-2,1,1/
64
65      data templates(2)%template_num /2/     !  Complex Packing
66      data templates(2)%mapdrslen /16/
67      data templates(2)%needext /.false./
68      data (templates(2)%mapdrs(j),j=1,16)
69     &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1/
70
71      data templates(3)%template_num /3/     !  Complex Packing - Spatial Diff
72      data templates(3)%mapdrslen /18/
73      data templates(3)%needext /.false./
74      data (templates(3)%mapdrs(j),j=1,18)
75     &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1,1,1/
76
77      data templates(4)%template_num /50/     !  Simple Packing - Spectral Data
78      data templates(4)%mapdrslen /5/
79      data templates(4)%needext /.false./
80      data (templates(4)%mapdrs(j),j=1,5)
81     &                         /4,-2,-2,1,4/
82
83      data templates(5)%template_num /51/    !  Complex Packing - Spectral Data
84      data templates(5)%mapdrslen /10/
85      data templates(5)%needext /.false./
86      data (templates(5)%mapdrs(j),j=1,10)
87     &                         /4,-2,-2,1,-4,2,2,2,4,1/
88
89      data templates(6)%template_num /40000/     !  JPEG2000 Encoding
90      data templates(6)%mapdrslen /7/
91      data templates(6)%needext /.false./
92      data (templates(6)%mapdrs(j),j=1,7)
93     &                             /4,-2,-2,1,1,1,1/
94
95      data templates(7)%template_num /40010/     !  PNG Encoding
96      data templates(7)%mapdrslen /5/
97      data templates(7)%needext /.false./
98      data (templates(7)%mapdrs(j),j=1,5)
99     &                             /4,-2,-2,1,1/
100
101      data templates(8)%template_num /40/     !  JPEG2000 Encoding
102      data templates(8)%mapdrslen /7/
103      data templates(8)%needext /.false./
104      data (templates(8)%mapdrs(j),j=1,7)
105     &                             /4,-2,-2,1,1,1,1/
106
107      data templates(9)%template_num /41/     !  PNG Encoding
108      data templates(9)%mapdrslen /5/
109      data templates(9)%needext /.false./
110      data (templates(9)%mapdrs(j),j=1,5)
111     &                             /4,-2,-2,1,1/
112
113!      data templates(5)%template_num /1/      !  Simple Packing - Matrix
114!      data templates(5)%mapdrslen /15/
115!      data templates(5)%needext /.true./
116!      data (templates(5)%mapdrs(j),j=1,15)
117!     &                        /4,-2,-2,1,1,1,4,2,2,1,1,1,1,1,1/
118
119
120      contains
121
122         integer function getdrsindex(number)
123!$$$  SUBPROGRAM DOCUMENTATION BLOCK
124!                .      .    .                                       .
125! SUBPROGRAM:    getdrsindex
126!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
127!
128! ABSTRACT: This function returns the index of specified Data
129!   Representation Template 5.NN (NN=number) in array templates.
130!
131! PROGRAM HISTORY LOG:
132! 2001-06-28  Gilbert
133!
134! USAGE:    index=getdrsindex(number)
135!   INPUT ARGUMENT LIST:
136!     number   - NN, indicating the number of the Data Representation
137!                Template 5.NN that is being requested.
138!
139! RETURNS:  Index of DRT 5.NN in array templates, if template exists.
140!           = -1, otherwise.
141!
142! REMARKS: None
143!
144! ATTRIBUTES:
145!   LANGUAGE: Fortran 90
146!   MACHINE:  IBM SP
147!
148!$$$
149           integer,intent(in) :: number
150
151           getdrsindex=-1
152
153           do j=1,MAXTEMP
154              if (number.eq.templates(j)%template_num) then
155                 getdrsindex=j
156                 return
157              endif
158           enddo
159
160         end function
161
162
163         subroutine getdrstemplate(number,nummap,map,needext,iret)
164!$$$  SUBPROGRAM DOCUMENTATION BLOCK
165!                .      .    .                                       .
166! SUBPROGRAM:    getdrstemplate
167!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
168!
169! ABSTRACT: This subroutine returns DRS template information for a
170!   specified Data Representation Template 5.NN.
171!   The number of entries in the template is returned along with a map
172!   of the number of octets occupied by each entry.  Also, a flag is
173!   returned to indicate whether the template would need to be extended.
174!
175! PROGRAM HISTORY LOG:
176! 2000-05-11  Gilbert
177!
178! USAGE:    CALL getdrstemplate(number,nummap,map,needext,iret)
179!   INPUT ARGUMENT LIST:
180!     number   - NN, indicating the number of the Data Representation
181!                Template 5.NN that is being requested.
182!
183!   OUTPUT ARGUMENT LIST:     
184!     nummap   - Number of entries in the Template
185!     map()    - An array containing the number of octets that each
186!                template entry occupies when packed up into the DRS.
187!     needext  - Logical variable indicating whether the Data Representation
188!                Template has to be extended. 
189!     ierr     - Error return code.
190!                0 = no error
191!                1 = Undefined Data Representation Template number.
192!
193! REMARKS: None
194!
195! ATTRIBUTES:
196!   LANGUAGE: Fortran 90
197!   MACHINE:  IBM SP
198!
199!$$$
200           integer,intent(in) :: number
201           integer,intent(out) :: nummap,map(*),iret
202           logical,intent(out) :: needext
203
204           iret=0
205
206           index=getdrsindex(number)
207
208           if (index.ne.-1) then
209              nummap=templates(index)%mapdrslen
210              needext=templates(index)%needext
211              map(1:nummap)=templates(index)%mapdrs(1:nummap)
212           else
213             nummap=0
214             needext=.false.
215             print *,'getdrstemplate: DRS Template ',number,
216     &               ' not defined.'
217             iret=1
218           endif
219
220         end subroutine
221
222         subroutine extdrstemplate(number,list,nummap,map)
223!$$$  SUBPROGRAM DOCUMENTATION BLOCK
224!                .      .    .                                       .
225! SUBPROGRAM:    extdrstemplate
226!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
227!
228! ABSTRACT: This subroutine generates the remaining octet map for a
229!   given Data Representation Template, if required.  Some Templates can
230!   vary depending on data values given in an earlier part of the
231!   Template, and it is necessary to know some of the earlier entry
232!   values to generate the full octet map of the Template.
233!
234! PROGRAM HISTORY LOG:
235! 2000-05-11  Gilbert
236!
237! USAGE:    CALL extdrstemplate(number,list,nummap,map)
238!   INPUT ARGUMENT LIST:
239!     number   - NN, indicating the number of the Data Representation
240!                Template 5.NN that is being requested.
241!     list()   - The list of values for each entry in the
242!                the Data Representation Template 5.NN.
243!
244!   OUTPUT ARGUMENT LIST:     
245!     nummap   - Number of entries in the Template
246!     map()    - An array containing the number of octets that each
247!                template entry occupies when packed up into the GDS.
248!
249! ATTRIBUTES:
250!   LANGUAGE: Fortran 90
251!   MACHINE:  IBM SP
252!
253!$$$
254           integer,intent(in) :: number,list(*)
255           integer,intent(out) :: nummap,map(*)
256
257           index=getdrsindex(number)
258           if (index.eq.-1) return
259
260           if ( .not. templates(index)%needext ) return
261           nummap=templates(index)%mapdrslen
262           map(1:nummap)=templates(index)%mapdrs(1:nummap)
263
264           if ( number.eq.1 ) then
265              N=list(11)+list(13)
266              do i=1,N
267                map(nummap+i)=4
268              enddo
269              nummap=nummap+N
270           endif
271
272         end subroutine
273
274      end module
275
276
277
Note: See TracBrowser for help on using the repository browser.