C-----------------------------------------------------------------------
SUBROUTINE GDSWZD(KGDS,IOPT,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: GDSWZD GRID DESCRIPTION SECTION WIZARD
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-04-10
C
C ABSTRACT: THIS SUBPROGRAM DECODES THE GRIB GRID DESCRIPTION SECTION
C (PASSED IN INTEGER FORM AS DECODED BY SUBPROGRAM W3FI63)
C AND RETURNS ONE OF THE FOLLOWING:
C (IOPT= 0) GRID AND EARTH COORDINATES OF ALL GRID POINTS
C (IOPT=+1) EARTH COORDINATES OF SELECTED GRID COORDINATES
C (IOPT=-1) GRID COORDINATES OF SELECTED EARTH COORDINATES
C THE CURRENT CODE RECOGNIZES THE FOLLOWING PROJECTIONS:
C (KGDS(1)=000) EQUIDISTANT CYLINDRICAL
C (KGDS(1)=001) MERCATOR CYLINDRICAL
C (KGDS(1)=003) LAMBERT CONFORMAL CONICAL
C (KGDS(1)=004) GAUSSIAN CYLINDRICAL
C (KGDS(1)=005) POLAR STEREOGRAPHIC AZIMUTHAL
C (KGDS(1)=201) STAGGERED ROTATED EQUIDISTANT CYLINDRICAL
C (KGDS(1)=202) ROTATED EQUIDISTANT CYLINDRICAL
C (KGDS(1)=203) E-STAGGERED ROTATED EQUIDISTANT CYLINDRICAL 2-D
C (KGDS(1)=205) B-STAGGERED ROTATED EQUIDISTANT CYLINDRICAL 2-D
C IF THE SELECTED COORDINATES ARE MORE THAN ONE GRIDPOINT
C BEYOND THE THE EDGES OF THE GRID DOMAIN, THEN THE RELEVANT
C OUTPUT ELEMENTS ARE SET TO FILL VALUES. ALSO IF IOPT=0,
C IF THE NUMBER OF GRID POINTS EXCEEDS THE NUMBER ALLOTTED,
C THEN ALL THE OUTPUT ELEMENTS ARE SET TO FILL VALUES.
C THE ACTUAL NUMBER OF VALID POINTS COMPUTED IS RETURNED TOO.
C OPTIONALLY, THE VECTOR ROTATIONS AND THE MAP JACOBIANS
C FOR THIS GRID MAY BE RETURNED AS WELL.
C
C PROGRAM HISTORY LOG:
C 1996-04-10 IREDELL
C 1997-10-20 IREDELL INCLUDE MAP OPTIONS
C 1998-08-20 BALDWIN ADD TYPE 203 2-D ETA GRIDS
C 2008-04-11 GAYNO ADD TYPE 205 - ROT LAT/LON B-STAGGER
C 2012-08-02 GAYNO FIX COMPUTATION OF I/J FOR 203 GRIDS WITH
C NSCAN /= 0.
C
C USAGE: CALL GDSWZD(KGDS,IOPT,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
C & LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C
C INPUT ARGUMENT LIST:
C KGDS - INTEGER (200) GDS PARAMETERS AS DECODED BY W3FI63
C IOPT - INTEGER OPTION FLAG
C ( 0 TO COMPUTE EARTH COORDS OF ALL THE GRID POINTS)
C (+1 TO COMPUTE EARTH COORDS OF SELECTED GRID COORDS)
C (-1 TO COMPUTE GRID COORDS OF SELECTED EARTH COORDS)
C NPTS - INTEGER MAXIMUM NUMBER OF COORDINATES
C FILL - REAL FILL VALUE TO SET INVALID OUTPUT DATA
C (MUST BE IMPOSSIBLE VALUE; SUGGESTED VALUE: -9999.)
C XPTS - REAL (NPTS) GRID X POINT COORDINATES IF IOPT>0
C YPTS - REAL (NPTS) GRID Y POINT COORDINATES IF IOPT>0
C RLON - REAL (NPTS) EARTH LONGITUDES IN DEGREES E IF IOPT<0
C (ACCEPTABLE RANGE: -360. TO 360.)
C RLAT - REAL (NPTS) EARTH LATITUDES IN DEGREES N IF IOPT<0
C (ACCEPTABLE RANGE: -90. TO 90.)
C LROT - INTEGER FLAG TO RETURN VECTOR ROTATIONS IF 1
C LMAP - INTEGER FLAG TO RETURN MAP JACOBIANS IF 1
C
C OUTPUT ARGUMENT LIST:
C XPTS - REAL (NPTS) GRID X POINT COORDINATES IF IOPT<=0
C YPTS - REAL (NPTS) GRID Y POINT COORDINATES IF IOPT<=0
C RLON - REAL (NPTS) EARTH LONGITUDES IN DEGREES E IF IOPT>=0
C RLAT - REAL (NPTS) EARTH LATITUDES IN DEGREES N IF IOPT>=0
C NRET - INTEGER NUMBER OF VALID POINTS COMPUTED
C (-1 IF PROJECTION UNRECOGNIZED)
C CROT - REAL (NPTS) CLOCKWISE VECTOR ROTATION COSINES IF LROT=1
C SROT - REAL (NPTS) CLOCKWISE VECTOR ROTATION SINES IF LROT=1
C (UGRID=CROT*UEARTH-SROT*VEARTH;
C VGRID=SROT*UEARTH+CROT*VEARTH)
C XLON - REAL (NPTS) DX/DLON IN 1/DEGREES IF LMAP=1
C XLAT - REAL (NPTS) DX/DLAT IN 1/DEGREES IF LMAP=1
C YLON - REAL (NPTS) DY/DLON IN 1/DEGREES IF LMAP=1
C YLAT - REAL (NPTS) DY/DLAT IN 1/DEGREES IF LMAP=1
C AREA - REAL (NPTS) AREA WEIGHTS IN M**2 IF LMAP=1
C (PROPORTIONAL TO THE SQUARE OF THE MAP FACTOR
C IN THE CASE OF CONFORMAL PROJECTIONS)
C
C SUBPROGRAMS CALLED:
C GDSWZD00 GDS WIZARD FOR EQUIDISTANT CYLINDRICAL
C GDSWZD01 GDS WIZARD FOR MERCATOR CYLINDRICAL
C GDSWZD03 GDS WIZARD FOR LAMBERT CONFORMAL CONICAL
C GDSWZD04 GDS WIZARD FOR GAUSSIAN CYLINDRICAL
C GDSWZD05 GDS WIZARD FOR POLAR STEREOGRAPHIC AZIMUTHAL
C GDSWZDC9 GDS WIZARD FOR ROTATED EQUIDISTANT CYLINDRICAL
C GDSWZDCA GDS WIZARD FOR ROTATED EQUIDISTANT CYLINDRICAL
C GDSWZDCB GDS WIZARD FOR ROTATED EQUIDISTANT CYLINDRICAL 2-D
C GDSWZDCD GDS WIZARD FOR ROTATED EQUIDISTANT CYLINDRICAL 2-D
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C
C$$$
IMPLICIT NONE
C
INTEGER, INTENT(IN ) :: IOPT, KGDS(200), LMAP, LROT, NPTS
INTEGER, INTENT( OUT) :: NRET
C
REAL, INTENT(IN ) :: FILL
REAL, INTENT(INOUT) :: RLON(NPTS),RLAT(NPTS)
REAL, INTENT(INOUT) :: XPTS(NPTS),YPTS(NPTS)
REAL, INTENT( OUT) :: CROT(NPTS),SROT(NPTS)
REAL, INTENT( OUT) :: XLON(NPTS),XLAT(NPTS)
REAL, INTENT( OUT) :: YLON(NPTS),YLAT(NPTS),AREA(NPTS)
C
INTEGER :: IS1, IM, JM, NM, KSCAN, NSCAN, N
INTEGER :: IOPF, NN, I, J
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C COMPUTE GRID COORDINATES FOR ALL GRID POINTS
IF(IOPT.EQ.0) THEN
IF(KGDS(1).EQ.201) THEN
IM=KGDS(7)*2-1
JM=KGDS(8)
KSCAN=MOD(KGDS(11)/256,2)
IF(KSCAN.EQ.0) THEN
IS1=(JM+1)/2
NM=(IM/2+1)*JM-JM/2
ELSE
IS1=JM/2
NM=IM/2*JM+JM/2
ENDIF
ELSEIF(KGDS(1).EQ.202) THEN
IM=KGDS(7)
JM=KGDS(8)
NM=IM*JM
ELSEIF(KGDS(1).EQ.203) THEN
IM=KGDS(2)
JM=KGDS(3)
NM=IM*JM
KSCAN=MOD(KGDS(11)/256,2)
IF(KSCAN.EQ.0) THEN
IS1=(JM+1)/2
ELSE
IS1=JM/2
ENDIF
ELSE
IM=KGDS(2)
JM=KGDS(3)
NM=IM*JM
ENDIF
NSCAN=MOD(KGDS(11)/32,2)
IF(NM.LE.NPTS) THEN
IF(KGDS(1).EQ.201) THEN
DO N=1,NM
NN=2*N-1+KSCAN
IF(NSCAN.EQ.0) THEN
J=(NN-1)/IM+1
I=NN-IM*(J-1)
ELSE
I=(NN-1)/JM+1
J=NN-JM*(I-1)
ENDIF
XPTS(N)=IS1+(I-(J-KSCAN))/2
YPTS(N)=(I+(J-KSCAN))/2
ENDDO
ELSEIF(KGDS(1).EQ.203) THEN
DO N=1,NM
IF(NSCAN.EQ.0) THEN
J=(N-1)/IM+1
I=(N-IM*(J-1))*2-MOD(J+KSCAN,2)
ELSE
NN=(N*2)-1+KSCAN
I = (NN-1)/JM + 1
J = MOD(NN-1,JM) + 1
IF (MOD(JM,2)==0.AND.MOD(I,2)==0.AND.KSCAN==0)
& J = J + 1
IF (MOD(JM,2)==0.AND.MOD(I,2)==0.AND.KSCAN==1)
& J = J - 1
ENDIF
XPTS(N)=IS1+(I-(J-KSCAN))/2
YPTS(N)=(I+(J-KSCAN))/2
ENDDO
ELSE
DO N=1,NM
IF(NSCAN.EQ.0) THEN
J=(N-1)/IM+1
I=N-IM*(J-1)
ELSE
I=(N-1)/JM+1
J=N-JM*(I-1)
ENDIF
XPTS(N)=I
YPTS(N)=J
ENDDO
ENDIF
DO N=NM+1,NPTS
XPTS(N)=FILL
YPTS(N)=FILL
ENDDO
ELSE
DO N=1,NPTS
XPTS(N)=FILL
YPTS(N)=FILL
ENDDO
ENDIF
IOPF=1
ELSE
IOPF=IOPT
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C EQUIDISTANT CYLINDRICAL
IF(KGDS(1).EQ.000) THEN
CALL GDSWZD00(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C MERCATOR CYLINDRICAL
ELSEIF(KGDS(1).EQ.001) THEN
CALL GDSWZD01(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C LAMBERT CONFORMAL CONICAL
ELSEIF(KGDS(1).EQ.003) THEN
CALL GDSWZD03(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C GAUSSIAN CYLINDRICAL
ELSEIF(KGDS(1).EQ.004) THEN
CALL GDSWZD04(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C POLAR STEREOGRAPHIC AZIMUTHAL
ELSEIF(KGDS(1).EQ.005) THEN
CALL GDSWZD05(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C STAGGERED ROTATED EQUIDISTANT CYLINDRICAL
ELSEIF(KGDS(1).EQ.201) THEN
CALL GDSWZDC9(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C ROTATED EQUIDISTANT CYLINDRICAL
ELSEIF(KGDS(1).EQ.202) THEN
CALL GDSWZDCA(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C 2-D E-STAGGERED ROTATED EQUIDISTANT CYLINDRICAL
ELSEIF(KGDS(1).EQ.203) THEN
CALL GDSWZDCB(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C 2-D B-STAGGERED ROTATED EQUIDISTANT CYLINDRICAL
ELSEIF(KGDS(1).EQ.205) THEN
CALL GDSWZDCD(KGDS,IOPF,NPTS,FILL,XPTS,YPTS,RLON,RLAT,NRET,
& LROT,CROT,SROT,LMAP,XLON,XLAT,YLON,YLAT,AREA)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C PROJECTION UNRECOGNIZED
ELSE
IF(IOPT.GE.0) THEN
DO N=1,NPTS
RLON(N)=FILL
RLAT(N)=FILL
ENDDO
ENDIF
IF(IOPT.LE.0) THEN
DO N=1,NPTS
XPTS(N)=FILL
YPTS(N)=FILL
ENDDO
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END