NCEPLIBS-ip  5.0.0
gdswzd_mod.F90
Go to the documentation of this file.
1 
6 
25 MODULE 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 CONTAINS
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 
879 END MODULE gdswzd_mod
gdswzd_mod::gdswzd
Definition: gdswzd_mod.F90:37
ip_grid_descriptor_mod::init_descriptor
Definition: ip_grid_descriptor_mod.F90:60
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:760
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_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:281
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_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:38
ip_grid_descriptor_mod::grib2_descriptor
Grib-2 descriptor containing a grib2 GDT represented by an integer array.
Definition: ip_grid_descriptor_mod.F90:47
ip_grid_mod::ip_grid
Abstract grid that holds fields and methods common to all grids.
Definition: ip_grid_mod.F90:52