NCEPLIBS-ip 4.0.0
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
46
47CONTAINS
48
49
108 subroutine gdswzd_grid(grid,IOPT,NPTS,FILL, &
109 XPTS,YPTS,RLON,RLAT,NRET, &
110 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
111
112 class(ip_grid), intent(in) :: grid
113 INTEGER, INTENT(IN ) :: IOPT, NPTS
114 INTEGER, INTENT( OUT) :: NRET
115 !
116 REAL, INTENT(IN ) :: FILL
117 REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
118 REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
119 REAL, OPTIONAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
120 REAL, OPTIONAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
121 REAL, OPTIONAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
122
123 INTEGER :: IS1, IM, JM, NM, KSCAN, NSCAN, N
124 INTEGER :: IOPF, NN, I, J
125 INTEGER :: I_OFFSET_ODD, I_OFFSET_EVEN
126
127 ! COMPUTE GRID COORDINATES FOR ALL GRID POINTS
128 IF(iopt.EQ.0) THEN
129 iopf=1
130
131 im = grid%im
132 jm = grid%jm
133 nm = im * jm
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 class default
168 DO n=1,nm
169 IF(nscan.EQ.0) THEN
170 j=(n-1)/im+1
171 i=n-im*(j-1)
172 ELSE
173 i=(n-1)/jm+1
174 j=n-jm*(i-1)
175 ENDIF
176 xpts(n)=i
177 ypts(n)=j
178 ENDDO
179 end select
180
181 DO n=nm+1,npts
182 xpts(n)=fill
183 ypts(n)=fill
184 ENDDO
185
186 ELSE ! IOPT /= 0
187 iopf=iopt
188 ENDIF ! IOPT CHECK
189
190 call grid%gdswzd(iopf,npts,fill, &
191 xpts,ypts,rlon,rlat,nret, &
192 crot,srot,xlon,xlat,ylon,ylat,area)
193
194 end subroutine gdswzd_grid
195
196
274 SUBROUTINE gdswzd_scalar(IGDTNUM,IGDTMPL,IGDTLEN,IOPT,NPTS,FILL, &
275 XPTS,YPTS,RLON,RLAT,NRET, &
276 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
277
278 IMPLICIT NONE
279 !
280 INTEGER, INTENT(IN ) :: IGDTNUM, IGDTLEN
281 INTEGER, INTENT(IN ) :: IGDTMPL(IGDTLEN)
282 INTEGER, INTENT(IN ) :: IOPT, NPTS
283 INTEGER, INTENT( OUT) :: NRET
284 !
285 REAL, INTENT(IN ) :: FILL
286 REAL, INTENT(INOUT) :: RLON, RLAT
287 REAL, INTENT(INOUT) :: XPTS, YPTS
288 REAL, OPTIONAL, INTENT( OUT) :: CROT, SROT
289 REAL, OPTIONAL, INTENT( OUT) :: XLON, XLAT
290 REAL, OPTIONAL, INTENT( OUT) :: YLON, YLAT, AREA
291
292 REAL :: RLONA(1),RLATA(1)
293 REAL :: XPTSA(1),YPTSA(1)
294 REAL :: CROTA(1),SROTA(1)
295 REAL :: XLONA(1),XLATA(1)
296 REAL :: YLONA(1),YLATA(1),AREAA(1)
297
298 rlona(1) = rlon
299 rlata(1) = rlat
300 xptsa(1) = xpts
301 yptsa(1) = ypts
302
303 nret = 0
304
305 ! CALL WITHOUT EXTRA FIELDS.
306
307 IF (.NOT. PRESENT(crot) .AND. &
308 .NOT. PRESENT(srot) .AND. &
309 .NOT. PRESENT(xlon) .AND. &
310 .NOT. PRESENT(xlat) .AND. &
311 .NOT. PRESENT(ylon) .AND. &
312 .NOT. PRESENT(ylat) .AND. &
313 .NOT. PRESENT(area) ) THEN
314
315 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
316 xptsa,yptsa,rlona,rlata,nret)
317
318 rlon = rlona(1)
319 rlat = rlata(1)
320 xpts = xptsa(1)
321 ypts = yptsa(1)
322
323 ENDIF
324
325 ! MIMIC CALL TO OLD 'GDSWIZ' ROUTINES.
326
327 IF (PRESENT(crot) .AND. &
328 PRESENT(srot) .AND. &
329 .NOT. PRESENT(xlon) .AND. &
330 .NOT. PRESENT(xlat) .AND. &
331 .NOT. PRESENT(ylon) .AND. &
332 .NOT. PRESENT(ylat) .AND. &
333 .NOT. PRESENT(area) ) THEN
334
335 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
336 xptsa,yptsa,rlona,rlata,nret,crota,srota)
337
338 rlon = rlona(1)
339 rlat = rlata(1)
340 xpts = xptsa(1)
341 ypts = yptsa(1)
342 crot = crota(1)
343 srot = srota(1)
344
345 ENDIF
346
347 ! MIMIC CALL TO OLD 'GDSWZD' ROUTINES.
348
349 IF (PRESENT(crot) .AND. &
350 PRESENT(srot) .AND. &
351 PRESENT(xlon) .AND. &
352 PRESENT(xlat) .AND. &
353 PRESENT(ylon) .AND. &
354 PRESENT(ylat) .AND. &
355 PRESENT(area) ) THEN
356
357 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
358 xptsa,yptsa,rlona,rlata,nret, &
359 crota,srota,xlona,xlata,ylona,ylata,areaa)
360
361 rlon = rlona(1)
362 rlat = rlata(1)
363 xpts = xptsa(1)
364 ypts = yptsa(1)
365 crot = crota(1)
366 srot = srota(1)
367 xlon = xlona(1)
368 xlat = xlata(1)
369 ylon = ylona(1)
370 ylat = ylata(1)
371 area = areaa(1)
372
373 ENDIF
374
375 RETURN
376
377 END SUBROUTINE gdswzd_scalar
378
456 SUBROUTINE gdswzd_2d_array(IGDTNUM,IGDTMPL,IGDTLEN,IOPT,NPTS,FILL, &
457 XPTS,YPTS,RLON,RLAT,NRET, &
458 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
459
460 IMPLICIT NONE
461 !
462 INTEGER, INTENT(IN ) :: IGDTNUM, IGDTLEN
463 INTEGER, INTENT(IN ) :: IGDTMPL(IGDTLEN)
464 INTEGER, INTENT(IN ) :: IOPT, NPTS
465 INTEGER, INTENT( OUT) :: NRET
466 !
467 REAL, INTENT(IN ) :: FILL
468 REAL, INTENT(INOUT) :: RLON(:,:),RLAT(:,:)
469 REAL, INTENT(INOUT) :: XPTS(:,:),YPTS(:,:)
470 REAL, OPTIONAL, INTENT( OUT) :: CROT(:,:),SROT(:,:)
471 REAL, OPTIONAL, INTENT( OUT) :: XLON(:,:),XLAT(:,:)
472 REAL, OPTIONAL, INTENT( OUT) :: YLON(:,:),YLAT(:,:),AREA(:,:)
473
474 CALL gdswzd_1d_array(igdtnum,igdtmpl,igdtlen,iopt,npts,fill, &
475 xpts,ypts,rlon,rlat,nret, &
476 crot,srot,xlon,xlat,ylon,ylat,area)
477
478 END SUBROUTINE gdswzd_2d_array
479
663 SUBROUTINE gdswzd_1d_array(IGDTNUM,IGDTMPL,IGDTLEN,IOPT,NPTS,FILL, &
664 XPTS,YPTS,RLON,RLAT,NRET, &
665 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
666 INTEGER, INTENT(IN ) :: IGDTNUM, IGDTLEN
667 INTEGER, INTENT(IN ) :: IGDTMPL(IGDTLEN)
668 INTEGER, INTENT(IN ) :: IOPT, NPTS
669 INTEGER, INTENT( OUT) :: NRET
670 !
671 REAL, INTENT(IN ) :: FILL
672 REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
673 REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
674 REAL, OPTIONAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
675 REAL, OPTIONAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
676 REAL, OPTIONAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
677
678 type(grib2_descriptor) :: desc
679 class(ip_grid), allocatable :: grid
680
681 desc = init_descriptor(igdtnum, igdtlen, igdtmpl)
682 call init_grid(grid, desc)
683
684 call gdswzd_grid(grid,iopt,npts,fill, &
685 xpts,ypts,rlon,rlat,nret, &
686 crot,srot,xlon,xlat,ylon,ylat,area)
687
688 END SUBROUTINE gdswzd_1d_array
689
757 SUBROUTINE gdswzd_grib1(KGDS,IOPT,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET, &
758 CROT,SROT,XLON,XLAT,YLON,YLAT,AREA)
759 INTEGER, INTENT(IN ) :: IOPT, KGDS(200), NPTS
760 INTEGER, INTENT( OUT) :: NRET
761 !
762 REAL, INTENT(IN ) :: FILL
763 REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
764 REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
765 REAL, OPTIONAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
766 REAL, OPTIONAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
767 REAL, OPTIONAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
768
769
770 type(grib1_descriptor) :: desc
771 class(ip_grid), allocatable :: grid
772
773 desc = init_descriptor(kgds)
774 call init_grid(grid, desc)
775
776 call gdswzd_grid(grid,iopt,npts,fill, &
777 xpts,ypts,rlon,rlat,nret, &
778 crot,srot,xlon,xlat,ylon,ylat,area)
779
780 END SUBROUTINE gdswzd_grib1
781
782
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:57
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_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:759
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:111
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_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:277
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:666
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:459
ip_grid_descriptor_mod
Uses derived type grid descriptor objects to abstract away the raw Grib-1 and Grib-2 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:8
ip_grid_descriptor_mod::grib1_descriptor
Descriptor representing a grib1 grib descriptor section (GDS) with an integer array.
Definition: ip_grid_descriptor_mod.f90:37
ip_grid_descriptor_mod::grib2_descriptor
Grib-2 descriptor containing a grib2 GDT represented by an integer array.
Definition: ip_grid_descriptor_mod.f90:45
ip_grid_mod::ip_grid
Abstract grid that holds fields and methods common to all grids.
Definition: ip_grid_mod.f90:45