source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/g2grids.F @ 3567

Last change on this file since 3567 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.5 KB
Line 
1      module g2grids
2!$$$  SUBPROGRAM DOCUMENTATION BLOCK
3!                .      .    .                                       .
4! MODULE:    g2grids
5!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-27
6!
7! ABSTRACT: This Fortran Module allows access to predefined GRIB2 Grid
8!   Definition Templates stored in a file.  The GDTs are represented by
9!   a predefined number or a character abbreviation.
10!
11!   At the first request, all the grid GDT entries in the file associated
12!   with input Fortran file unit number, lunit, are read into a linked list
13!   named gridlist.  This list is searched for the requested entry.
14!
15!   Users of this Fortran module should only call routines getgridbynum
16!   and getgridbyname.
17!
18!   The format of the file scanned by routines in this module is as follows.
19!   Each line contains one Grid entry containing five fields, each separated
20!   by a colon, ":".  The fields are:
21!      1) - predefined grid number
22!      2) - Up to an 8 character abbreviation
23!      3) - Grid Definition Template number
24!      4) - Number of entries in the Grid Definition Template
25!      5) - A list of values for each entry in the Grid Definition Template.
26!
27!   As an example, this is the entry for the 1x1 GFS global grid
28!   3:gbl_1deg:  0:19: 0 0 0 0 0 0 0 360 181 0 0 90000000 0 48 -90000000 359000000 1000000 1000000 0
29!
30!   Comments can be included in the file by specifying the symbol "#" as the
31!   first character on the line.  These lines are ignored.
32!
33!
34! PROGRAM HISTORY LOG:
35! 2004-04-27  Gilbert
36!
37! USAGE:    use g2grids
38!
39! ATTRIBUTES:
40!   LANGUAGE: Fortran 90
41!   MACHINE:  IBM SP
42!
43!$$$
44
45      integer,parameter :: MAXTEMP=200
46
47      type,private :: g2grid
48          integer :: grid_num
49          integer :: gdt_num
50          integer :: gdt_len
51          integer,dimension(MAXTEMP) :: gridtmpl
52          character(len=8) :: cdesc
53          type(g2grid),pointer :: next
54      end type g2grid
55
56      type(g2grid),pointer,private :: gridlist
57      integer :: num_grids=0
58
59      contains
60
61
62         integer function readgrids(lunit)
63!$$$  SUBPROGRAM DOCUMENTATION BLOCK
64!                .      .    .                                       .
65! SUBPROGRAM:    readgrids
66!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
67!
68! ABSTRACT: This function reads the list of GDT entries in the file
69!   associated with fortran unit, lunit.  All the entries are stored in a
70!   linked list called gridlist.
71!
72! PROGRAM HISTORY LOG:
73! 2001-06-28  Gilbert
74!
75! USAGE:    number=readgrids(lunit)
76!   INPUT ARGUMENT LIST:
77!     lunit   - Fortran unit number associated the the GDT file.
78!
79! RETURNS:  The number of Grid Definition Templates read in.
80!
81! REMARKS: None
82!
83! ATTRIBUTES:
84!   LANGUAGE: Fortran 90
85!   MACHINE:  IBM SP
86!
87!$$$
88           integer,intent(in) :: lunit
89
90           integer,parameter :: linelen=1280
91           character(len=8) :: desc
92           character(len=linelen) :: cline
93           integer  ient,igdtn,igdtmpl(200),igdtlen
94           integer :: pos1,pos2,pos3,pos4
95
96           type(g2grid),pointer :: gtemp
97           type(g2grid),pointer :: prev
98           integer count
99
100           count=0
101
102           !   For each line in the file....
103           DO
104             !  Read line into buffer
105             !
106             cline(1:linelen)=' '
107             read(lunit,end=999,fmt='(a)') cline
108
109             !
110             !  Skip line if commented out
111             !
112             if (cline(1:1).eq.'#') cycle
113
114             !
115             !  find positions of delimiters, ":"
116             !
117             pos1=index(cline,':')
118             cline(pos1:pos1)=';'
119             pos2=index(cline,':')
120             cline(pos2:pos2)=';'
121             pos3=index(cline,':')
122             cline(pos3:pos3)=';'
123             pos4=index(cline,':')
124             if ( pos1.eq.0 .or. pos2.eq.0 .or. pos3.eq.0 .or.
125     &            pos4.eq.0) cycle
126
127             !
128             !  Read each of the five fields.
129             !
130             read(cline(1:pos1-1),*) ient
131             read(cline(pos1+1:pos2-1),*) desc
132             read(cline(pos2+1:pos3-1),*) igdtn
133             read(cline(pos3+1:pos4-1),*) igdtlen
134             read(cline(pos4+1:linelen),*) (igdtmpl(j),j=1,igdtlen)
135
136             !
137             !  Allocate new type(g2grid) variable to store the GDT
138             !
139             allocate(gtemp,stat=iom)
140             count=count+1
141             gtemp%grid_num=ient
142             gtemp%gdt_num=igdtn
143             gtemp%gdt_len=igdtlen
144             gtemp%gridtmpl=igdtmpl
145             gtemp%cdesc=desc
146             nullify(gtemp%next)              ! defines end of linked list.
147             if ( count .eq. 1 ) then
148                gridlist => gtemp
149             else                       ! make sure previous entry in list
150                prev%next => gtemp      ! points to the new entry,
151             endif
152             prev => gtemp
153
154           enddo
155
156 999       readgrids=count
157           return
158
159         end function
160
161
162         subroutine getgridbynum(lunit,number,igdtn,igdtmpl,iret)
163!$$$  SUBPROGRAM DOCUMENTATION BLOCK
164!                .      .    .                                       .
165! SUBPROGRAM:    getgridbynum
166!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-26
167!
168! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
169!   for a Grid Definition Template assigned to the requested number.
170!   The input file format is described at the top of this module.
171!
172! PROGRAM HISTORY LOG:
173! 2004-04-26  Gilbert
174!
175! USAGE:    CALL getgridbynum(lunit,number,igdtn,igdtmpl,iret)
176!   INPUT ARGUMENT LIST:
177!     lunit    - Unit number of file containing Grid definitions
178!     number   - Grid number of the requested Grid definition
179!
180!   OUTPUT ARGUMENT LIST:     
181!     igdtn    - NN, indicating the number of the Grid Definition
182!                Template 3.NN
183!     igdtmpl()- An array containing the values of each entry in
184!                the Grid Definition Template.
185!     iret     - Error return code.
186!                0 = no error
187!               -1 = Undefined Grid number.
188!                3 = Could not read any grids from file.
189!
190! REMARKS: None
191!
192! ATTRIBUTES:
193!   LANGUAGE: Fortran 90
194!   MACHINE:  IBM SP
195!
196!$$$
197           integer,intent(in) :: lunit,number
198           integer,intent(out) :: igdtn,igdtmpl(*),iret
199
200           type(g2grid),pointer :: tempgrid
201
202           iret=0
203           igdtn=-1
204           !igdtmpl=0
205
206           !
207           !  If no grids in list, try reading them from the file.
208           !
209           if ( num_grids .eq. 0 ) then
210              num_grids=readgrids(lunit)
211           endif
212
213           if ( num_grids .eq. 0 ) then
214              iret=3                         ! problem reading file
215              return
216           endif
217
218           tempgrid => gridlist
219
220           !
221           !  Search through list
222           !
223           do while ( associated(tempgrid) )
224               if ( number .eq. tempgrid%grid_num ) then
225                  igdtn=tempgrid%gdt_num
226                  igdtmpl(1:tempgrid%gdt_len)=
227     &                        tempgrid%gridtmpl(1:tempgrid%gdt_len)
228                  return
229               else
230                  tempgrid => tempgrid%next
231               endif
232           enddo
233 
234           iret=-1
235           return
236 
237         end subroutine
238
239
240         subroutine getgridbyname(lunit,name,igdtn,igdtmpl,iret)
241!$$$  SUBPROGRAM DOCUMENTATION BLOCK
242!                .      .    .                                       .
243! SUBPROGRAM:    getgridbyname
244!   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-04-26
245!
246! ABSTRACT: This subroutine searches a file referenced by fortran unit lunit
247!   for a Grid Definition Template assigned to the requested name.
248!   The input file format is described at the top of this module.
249!
250! PROGRAM HISTORY LOG:
251! 2004-04-26  Gilbert
252!
253! USAGE:    CALL getgridbyname(lunit,name,igdtn,igdtmpl,iret)
254!   INPUT ARGUMENT LIST:
255!     lunit    - Unit number of file containing Grid definitions
256!     name     - Grid name of the requested Grid definition
257!
258!   OUTPUT ARGUMENT LIST:     
259!     igdtn    - NN, indicating the number of the Grid Definition
260!                Template 3.NN
261!     igdtmpl()- An array containing the values of each entry in
262!                the Grid Definition Template.
263!     iret     - Error return code.
264!                0 = no error
265!               -1 = Undefined Grid number.
266!                3 = Could not read any grids from file.
267!
268! REMARKS: None
269!
270! ATTRIBUTES:
271!   LANGUAGE: Fortran 90
272!   MACHINE:  IBM SP
273!
274!$$$
275           integer,intent(in) :: lunit
276           character(len=8),intent(in) :: name
277           integer,intent(out) :: igdtn,igdtmpl(*),iret
278
279           type(g2grid),pointer :: tempgrid
280
281           iret=0
282           igdtn=-1
283           !igdtmpl=0
284
285           !
286           !  If no grids in list, try reading them from the file.
287           !
288           if ( num_grids .eq. 0 ) then
289              num_grids=readgrids(lunit)
290           endif
291
292           if ( num_grids .eq. 0 ) then
293              iret=3                         ! problem reading file
294              return
295           endif
296
297           tempgrid => gridlist
298
299           !
300           !  Search through list
301           !
302           do while ( associated(tempgrid) )
303               if ( name .eq. tempgrid%cdesc ) then
304                  igdtn=tempgrid%gdt_num
305                  igdtmpl(1:tempgrid%gdt_len)=
306     &                     tempgrid%gridtmpl(1:tempgrid%gdt_len)
307                  return
308               else
309                  tempgrid => tempgrid%next
310               endif
311           enddo
312 
313           iret=-1
314           return
315 
316         end subroutine
317
318
319      end
320
Note: See TracBrowser for help on using the repository browser.