NCEPLIBS-ip 5.2.0
Loading...
Searching...
No Matches
gdswzd_mod.F90
Go to the documentation of this file.
1
6
25MODULE gdswzd_mod
26 use ip_grid_descriptor_mod
27 use ip_grids_mod
28 use ip_grid_mod
29 use ip_grid_factory_mod
30
31 IMPLICIT NONE
32
33 PRIVATE
34
35 public :: gdswzd_2d_array_grib1, gdswzd_grib1, gdswzd
36
37 INTERFACE gdswzd
38 MODULE PROCEDURE gdswzd_1d_array
39 MODULE PROCEDURE gdswzd_2d_array
40 MODULE PROCEDURE gdswzd_scalar
41 module procedure gdswzd_grib1
42 module procedure gdswzd_2d_array_grib1
43 module procedure gdswzd_grid
44 END INTERFACE gdswzd
45
46CONTAINS
47
105 subroutine gdswzd_grid(grid,IOPT,NPTS,FILL, &
106 XPTS,YPTS,RLON,RLAT,NRET, &
107 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
108
109 class(ip_grid), intent(in) :: grid
110 INTEGER, INTENT(IN ) :: IOPT, NPTS
111 INTEGER, INTENT( OUT) :: NRET
112 !
113 REAL, INTENT(IN ) :: FILL
114 REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
115 REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
116 REAL, OPTIONAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
117 REAL, OPTIONAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
118 REAL, OPTIONAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
119
120 INTEGER :: IS1, IM, JM, NM, KSCAN, NSCAN, N
121 INTEGER :: IOPF, NN, I, J
122
123 ! COMPUTE GRID COORDINATES FOR ALL GRID POINTS
124 IF(iopt.EQ.0) THEN
125 iopf=1
126
127 if(grid%descriptor%grid_num.eq.-1)then
128 nm = npts
129 else
130 im = grid%im
131 jm = grid%jm
132 nm = im * jm
133 endif
134 nscan = grid%nscan
135 kscan = grid%kscan
136
137 if (nm > npts) then
138 rlat=fill
139 rlon=fill
140 xpts=fill
141 ypts=fill
142 return
143 end if
144
145 select type(grid)
146 type is(ip_rot_equid_cylind_egrid)
147 if(kscan == 0) then
148 is1 = (jm + 1) / 2
149 else
150 is1 = jm / 2
151 end if
152
153 DO n=1,nm
154 IF(nscan.EQ.0) THEN
155 j=(n-1)/im+1
156 i=(n-im*(j-1))*2-mod(j+kscan,2)
157 ELSE
158 nn=(n*2)-1+kscan
159 i = (nn-1)/jm + 1
160 j = mod(nn-1,jm) + 1
161 IF (mod(jm,2)==0.AND.mod(i,2)==0.AND.kscan==0) j = j + 1
162 IF (mod(jm,2)==0.AND.mod(i,2)==0.AND.kscan==1) j = j - 1
163 ENDIF
164 xpts(n)=is1+(i-(j-kscan))/2
165 ypts(n)=(i+(j-kscan))/2
166 ENDDO
167 type is(ip_station_points_grid)
168 DO n=1,nm
169 xpts(n)=fill
170 ypts(n)=fill
171 ENDDO
172 class default
173 DO n=1,nm
174 IF(nscan.EQ.0) THEN
175 j=(n-1)/im+1
176 i=n-im*(j-1)
177 ELSE
178 i=(n-1)/jm+1
179 j=n-jm*(i-1)
180 ENDIF
181 xpts(n)=i
182 ypts(n)=j
183 ENDDO
184 end select
185
186 DO n=nm+1,npts
187 xpts(n)=fill
188 ypts(n)=fill
189 ENDDO
190
191 ELSE ! IOPT /= 0
192 iopf=iopt
193 ENDIF ! IOPT CHECK
194
195 call grid%gdswzd(iopf,npts,fill, &
196 xpts,ypts,rlon,rlat,nret, &
197 crot,srot,xlon,xlat,ylon,ylat,area)
198
199 end subroutine gdswzd_grid
200
201
278 SUBROUTINE gdswzd_scalar(IGDTNUM,IGDTMPL,IGDTLEN,IOPT,NPTS,FILL, &
279 XPTS,YPTS,RLON,RLAT,NRET, &
280 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
281
282 IMPLICIT NONE
283 !
284 INTEGER, INTENT(IN ) :: IGDTNUM, IGDTLEN
285 INTEGER, INTENT(IN ) :: IGDTMPL(IGDTLEN)
286 INTEGER, INTENT(IN ) :: IOPT, NPTS
287 INTEGER, INTENT( OUT) :: NRET
288 !
289 REAL, INTENT(IN ) :: FILL
290 REAL, INTENT(INOUT) :: RLON, RLAT
291 REAL, INTENT(INOUT) :: XPTS, YPTS
292 REAL, OPTIONAL, INTENT( OUT) :: CROT, SROT
293 REAL, OPTIONAL, INTENT( OUT) :: XLON, XLAT
294 REAL, OPTIONAL, INTENT( OUT) :: YLON, YLAT, AREA
295
296 REAL :: RLONA(1),RLATA(1)
297 REAL :: XPTSA(1),YPTSA(1)
298 REAL :: CROTA(1),SROTA(1)
299 REAL :: XLONA(1),XLATA(1)
300 REAL :: YLONA(1),YLATA(1),AREAA(1)
301
302 rlona(1) = rlon
303 rlata(1) = rlat
304 xptsa(1) = xpts
305 yptsa(1) = ypts
306
307 nret = 0
308
309 ! CALL WITHOUT EXTRA FIELDS.
310
311 IF (.NOT. PRESENT(crot) .AND. &
312 .NOT. PRESENT(srot) .AND. &
313 .NOT. PRESENT(xlon) .AND. &
314 .NOT. PRESENT(xlat) .AND. &
315 .NOT. PRESENT(ylon) .AND. &
316 .NOT. PRESENT(ylat) .AND. &
317 .NOT. PRESENT(area) ) THEN
318
319 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
320 xptsa,yptsa,rlona,rlata,nret)
321
322 rlon = rlona(1)
323 rlat = rlata(1)
324 xpts = xptsa(1)
325 ypts = yptsa(1)
326
327 ENDIF
328
329 ! MIMIC CALL TO OLD 'GDSWIZ' ROUTINES.
330
331 IF (PRESENT(crot) .AND. &
332 PRESENT(srot) .AND. &
333 .NOT. PRESENT(xlon) .AND. &
334 .NOT. PRESENT(xlat) .AND. &
335 .NOT. PRESENT(ylon) .AND. &
336 .NOT. PRESENT(ylat) .AND. &
337 .NOT. PRESENT(area) ) THEN
338
339 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
340 xptsa,yptsa,rlona,rlata,nret,crota,srota)
341
342 rlon = rlona(1)
343 rlat = rlata(1)
344 xpts = xptsa(1)
345 ypts = yptsa(1)
346 crot = crota(1)
347 srot = srota(1)
348
349 ENDIF
350
351 ! MIMIC CALL TO OLD 'GDSWZD' ROUTINES.
352
353 IF (PRESENT(crot) .AND. &
354 PRESENT(srot) .AND. &
355 PRESENT(xlon) .AND. &
356 PRESENT(xlat) .AND. &
357 PRESENT(ylon) .AND. &
358 PRESENT(ylat) .AND. &
359 PRESENT(area) ) THEN
360
361 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
362 xptsa,yptsa,rlona,rlata,nret, &
363 crota,srota,xlona,xlata,ylona,ylata,areaa)
364
365 rlon = rlona(1)
366 rlat = rlata(1)
367 xpts = xptsa(1)
368 ypts = yptsa(1)
369 crot = crota(1)
370 srot = srota(1)
371 xlon = xlona(1)
372 xlat = xlata(1)
373 ylon = ylona(1)
374 ylat = ylata(1)
375 area = areaa(1)
376
377 ENDIF
378
379 RETURN
380
381 END SUBROUTINE gdswzd_scalar
382
459 SUBROUTINE gdswzd_2d_array(IGDTNUM,IGDTMPL,IGDTLEN,IOPT,NPTS,FILL, &
460 XPTS,YPTS,RLON,RLAT,NRET, &
461 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
462
463 IMPLICIT NONE
464 !
465 INTEGER, INTENT(IN ) :: IGDTNUM, IGDTLEN
466 INTEGER, INTENT(IN ) :: IGDTMPL(IGDTLEN)
467 INTEGER, INTENT(IN ) :: IOPT, NPTS
468 INTEGER, INTENT( OUT) :: NRET
469 !
470 REAL, INTENT(IN ) :: FILL
471 REAL, INTENT(INOUT) :: RLON(:,:),RLAT(:,:)
472 REAL, INTENT(INOUT) :: XPTS(:,:),YPTS(:,:)
473 REAL, OPTIONAL, INTENT( OUT) :: CROT(:,:),SROT(:,:)
474 REAL, OPTIONAL, INTENT( OUT) :: XLON(:,:),XLAT(:,:)
475 REAL, OPTIONAL, INTENT( OUT) :: YLON(:,:),YLAT(:,:),AREA(:,:)
476
477 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
478 xpts,ypts,rlon,rlat,nret, &
479 crot,srot,xlon,xlat,ylon,ylat,area)
480
481 END SUBROUTINE gdswzd_2d_array
482
665 SUBROUTINE gdswzd_1d_array(IGDTNUM,IGDTMPL,IGDTLEN,IOPT,NPTS,FILL, &
666 XPTS,YPTS,RLON,RLAT,NRET, &
667 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
668 INTEGER, INTENT(IN ) :: IGDTNUM, IGDTLEN
669 INTEGER, INTENT(IN ) :: IGDTMPL(IGDTLEN)
670 INTEGER, INTENT(IN ) :: IOPT, NPTS
671 INTEGER, INTENT( OUT) :: NRET
672 !
673 REAL, INTENT(IN ) :: FILL
674 REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
675 REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
676 REAL, OPTIONAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
677 REAL, OPTIONAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
678 REAL, OPTIONAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
679
680 type(grib2_descriptor) :: desc
681 class(ip_grid), allocatable :: grid
682
683 desc = init_descriptor(igdtnum, igdtlen, igdtmpl)
684 call init_grid(grid, desc)
685
686 call gdswzd_grid(grid,iopt,npts,fill, &
687 xpts,ypts,rlon,rlat,nret, &
688 crot,srot,xlon,xlat,ylon,ylat,area)
689
690 END SUBROUTINE gdswzd_1d_array
691
758 SUBROUTINE gdswzd_grib1(KGDS,IOPT,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET, &
759 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
760 INTEGER, INTENT(IN ) :: IOPT, KGDS(200), NPTS
761 INTEGER, INTENT( OUT) :: NRET
762 !
763 REAL, INTENT(IN ) :: FILL
764 REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
765 REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
766 REAL, OPTIONAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
767 REAL, OPTIONAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
768 REAL, OPTIONAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
769
770
771 type(grib1_descriptor) :: desc
772 class(ip_grid), allocatable :: grid
773
774 desc = init_descriptor(kgds)
775 call init_grid(grid, desc)
776
777 call gdswzd_grid(grid,iopt,npts,fill, &
778 xpts,ypts,rlon,rlat,nret, &
779 crot,srot,xlon,xlat,ylon,ylat,area)
780
781 END SUBROUTINE gdswzd_grib1
782
783
850 SUBROUTINE gdswzd_2d_array_grib1(KGDS,IOPT,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET, &
851 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
852
853 !$$$
854 INTEGER, INTENT(IN ) :: IOPT, KGDS(200), NPTS
855 INTEGER, INTENT( OUT) :: NRET
856 !
857 REAL, INTENT(IN ) :: FILL
858 REAL, INTENT(INOUT) :: RLON(:,:),RLAT(:,:)
859 REAL, INTENT(INOUT) :: XPTS(:,:),YPTS(:,:)
860 REAL, OPTIONAL, INTENT( OUT) :: CROT(:,:),SROT(:,:)
861 REAL, OPTIONAL, INTENT( OUT) :: XLON(:,:),XLAT(:,:)
862 REAL, OPTIONAL, INTENT( OUT) :: YLON(:,:),YLAT(:,:),AREA(:,:)
863
864
865 type(grib1_descriptor) :: desc
866 class(ip_grid), allocatable :: grid
867
868 desc = init_descriptor(kgds)
869 call init_grid(grid, desc)
870
871 call gdswzd_grid(grid,iopt,npts,fill, &
872 xpts,ypts,rlon,rlat,nret, &
873 crot,srot,xlon,xlat,ylon,ylat,area)
874
875 END SUBROUTINE gdswzd_2d_array_grib1
876
877
878
879END MODULE gdswzd_mod
gdswzd_mod::gdswzd
Definition gdswzd_mod.F90:37
ip_grid_descriptor_mod::init_descriptor
Definition ip_grid_descriptor_mod.F90:63
ip_grid_factory_mod::init_grid
Definition ip_grid_factory_mod.F90:20
gdswzd_mod
Driver module for gdswzd routines.
Definition gdswzd_mod.F90:25
gdswzd_mod::gdswzd_grid
subroutine gdswzd_grid(grid, iopt, npts, fill, xpts, ypts, rlon, rlat, nret, crot, srot, xlon, xlat, ylon, ylat, area)
Returns one of the following for a grid object:
Definition gdswzd_mod.F90:108
gdswzd_mod::gdswzd_1d_array
subroutine gdswzd_1d_array(igdtnum, igdtmpl, igdtlen, iopt, npts, fill, xpts, ypts, rlon, rlat, nret, crot, srot, xlon, xlat, ylon, ylat, area)
Decodes the grib 2 grid definition template and returns one of the following:
Definition gdswzd_mod.F90:668
gdswzd_mod::gdswzd_grib1
subroutine, public gdswzd_grib1(kgds, iopt, npts, fill, xpts, ypts, rlon, rlat, nret, crot, srot, xlon, xlat, ylon, ylat, area)
Decodes the grib grid description section and returns one of the following (for 1-d arrays):
Definition gdswzd_mod.F90:760
gdswzd_mod::gdswzd_scalar
subroutine gdswzd_scalar(igdtnum, igdtmpl, igdtlen, iopt, npts, fill, xpts, ypts, rlon, rlat, nret, crot, srot, xlon, xlat, ylon, ylat, area)
Decodes the grib 2 grid definition template and returns one of the following (for scalars):
Definition gdswzd_mod.F90:281
gdswzd_mod::gdswzd_2d_array_grib1
subroutine, public gdswzd_2d_array_grib1(kgds, iopt, npts, fill, xpts, ypts, rlon, rlat, nret, crot, srot, xlon, xlat, ylon, ylat, area)
Decodes the grib grid description section and returns one of the following (for 2-d arrays):
Definition gdswzd_mod.F90:852
gdswzd_mod::gdswzd_2d_array
subroutine gdswzd_2d_array(igdtnum, igdtmpl, igdtlen, iopt, npts, fill, xpts, ypts, rlon, rlat, nret, crot, srot, xlon, xlat, ylon, ylat, area)
Decodes the grib 2 grid definition template and returns one of the following (for 2d-arrays):
Definition gdswzd_mod.F90:462
ip_grid_descriptor_mod
Users derived type grid descriptor objects to abstract away the raw GRIB1 and GRIB2 grid definitions.
Definition ip_grid_descriptor_mod.F90:15
ip_grid_factory_mod
Routines for creating an ip_grid given a Grib descriptor.
Definition ip_grid_factory_mod.F90:11
ip_grid_mod
Abstract ip_grid type.
Definition ip_grid_mod.F90:10
ip_grids_mod
Re-export the individual grids.
Definition ip_grids_mod.F90:7
ip_grid_descriptor_mod::grib1_descriptor
Descriptor representing a grib1 grib descriptor section (GDS) with an integer array.
Definition ip_grid_descriptor_mod.F90:39
ip_grid_descriptor_mod::grib2_descriptor
Grib-2 descriptor containing a grib2 GDT represented by an integer array.
Definition ip_grid_descriptor_mod.F90:49
ip_grid_mod::ip_grid
Abstract grid that holds fields and methods common to all grids.
Definition ip_grid_mod.F90:58