forked from erget/wgrib2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmakgds.f
executable file
·162 lines (162 loc) · 7.17 KB
/
makgds.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
C-----------------------------------------------------------------------
SUBROUTINE MAKGDS(IOPT,KGDS,GDS,LENGDS,IRET)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: MAKGDS MAKE OR BREAK A GRID DESCRIPTION SECTION
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-04-10
C
C ABSTRACT: THIS SUBPROGRAM MAKES OR BREAKS A GRID DESCRIPTION SECTION.
C IT CAN DO ONE OF THE FOLLOWING:
C (IOPT=-1) UNPACK A GDS INTO W3FI63 KGDS INTEGER FORM
C (IOPT=255) PACK A GDS FROM W3FI63 KGDS INTEGER FORM
C (0<IOPT<255) PACK A GDS FROM AN NCEP GRID IDENTIFICATION
C
C PROGRAM HISTORY LOG:
C 96-04-10 IREDELL
C
C USAGE: CALL MAKGDS(IOPT,KGDS,GDS,LENGDS,IRET)
C
C INPUT ARGUMENT LIST:
C IOPT - INTEGER OPTION
C IOPT=-1 TO UNPACK GDS INTO KGDS;
C IOPT=255 TO USE KGDS TO PACK GDS;
C 0<IOPT<255 NCEP GRID ID TO MAKE GDS AND KGDS.
C KGDS - INTEGER (200) W3FI63-STYLE UNPACKED GDS (IF IOPT=255)
C (ONLY FIRST 22 VALUES ARE ACCESSED IF KGDS(20)=255.)
C (SEE REMARKS BELOW FOR A DETAILED DESCRIPTION OF KGDS.)
C GDS - CHARACTER (400) GRID DEFINITION SECTION (IF IOPT=-1)
C
C OUTPUT ARGUMENT LIST:
C KGDS - INTEGER (200) W3FI63-STYLE UNPACKED GDS (IF IOPT<255)
C (ONLY FIRST 22 VALUES ARE ACCESSED IF KGDS(20)=255.)
C (SEE REMARKS BELOW FOR A DETAILED DESCRIPTION OF KGDS.)
C GDS - CHARACTER (400) GRID DEFINITION SECTION (IF IOPT>0)
C LENGDS - INTEGER LENGTH OF THE GDS (IF IOPT>0)
C IRET - INTEGER RETURN CODE
C 0 SUCCESSFUL
C 1 GRID REPRESENTATION TYPE NOT VALID
C 4 DATA REPRESENTATION TYPE NOT CURRENTLY ACCEPTABLE
C
C REMARKS: THE KGDS PARAMETERS ARE DESCRIBED BELOW
C AS COPIED FROM THE W3FI63 DOCBLOCK.
C (1) - DATA REPRESENTATION TYPE
C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS
C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE
C PARAMETERS
C OR
C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS
C IN EACH ROW
C OR
C 255 IF NEITHER ARE PRESENT
C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID
C (22) - NUMBER OF WORDS IN EACH ROW
C LATITUDE/LONGITUDE GRIDS
C (2) - N(I) NR POINTS ON LATITUDE CIRCLE
C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN
C (4) - LA(1) LATITUDE OF ORIGIN
C (5) - LO(1) LONGITUDE OF ORIGIN
C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
C (7) - LA(2) LATITUDE OF EXTREME POINT
C (8) - LO(2) LONGITUDE OF EXTREME POINT
C (9) - DI LATITUDINAL DIRECTION OF INCREMENT
C (10) - DJ LONGITUDINAL DIRECTION INCREMENT
C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
C GAUSSIAN GRIDS
C (2) - N(I) NR POINTS ON LATITUDE CIRCLE
C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN
C (4) - LA(1) LATITUDE OF ORIGIN
C (5) - LO(1) LONGITUDE OF ORIGIN
C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
C (7) - LA(2) LATITUDE OF EXTREME POINT
C (8) - LO(2) LONGITUDE OF EXTREME POINT
C (9) - DI LATITUDINAL DIRECTION OF INCREMENT
C (10) - N - NR OF CIRCLES POLE TO EQUATOR
C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
C (12) - NV - NR OF VERT COORD PARAMETERS
C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS
C OR
C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN
C EACH ROW (IF NO VERT COORD PARAMETERS
C ARE PRESENT
C OR
C 255 IF NEITHER ARE PRESENT
C POLAR STEREOGRAPHIC GRIDS
C (2) - N(I) NR POINTS ALONG LAT CIRCLE
C (3) - N(J) NR POINTS ALONG LON CIRCLE
C (4) - LA(1) LATITUDE OF ORIGIN
C (5) - LO(1) LONGITUDE OF ORIGIN
C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
C (7) - LOV GRID ORIENTATION
C (8) - DX - X DIRECTION INCREMENT
C (9) - DY - Y DIRECTION INCREMENT
C (10) - PROJECTION CENTER FLAG
C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28)
C SPHERICAL HARMONIC COEFFICIENTS
C (2) - J PENTAGONAL RESOLUTION PARAMETER
C (3) - K " " "
C (4) - M " " "
C (5) - REPRESENTATION TYPE
C (6) - COEFFICIENT STORAGE MODE
C MERCATOR GRIDS
C (2) - N(I) NR POINTS ON LATITUDE CIRCLE
C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN
C (4) - LA(1) LATITUDE OF ORIGIN
C (5) - LO(1) LONGITUDE OF ORIGIN
C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
C (7) - LA(2) LATITUDE OF LAST GRID POINT
C (8) - LO(2) LONGITUDE OF LAST GRID POINT
C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION
C (10) - RESERVED
C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
C (12) - LONGITUDINAL DIR GRID LENGTH
C (13) - LATITUDINAL DIR GRID LENGTH
C LAMBERT CONFORMAL GRIDS
C (2) - NX NR POINTS ALONG X-AXIS
C (3) - NY NR POINTS ALONG Y-AXIS
C (4) - LA1 LAT OF ORIGIN (LOWER LEFT)
C (5) - LO1 LON OF ORIGIN (LOWER LEFT)
C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17)
C (7) - LOV - ORIENTATION OF GRID
C (8) - DX - X-DIR INCREMENT
C (9) - DY - Y-DIR INCREMENT
C (10) - PROJECTION CENTER FLAG
C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER
C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER
C
C SUBPROGRAMS CALLED:
C FI633 EXTRACT INFO FROM GRIB-GDS
C R63W72 CONVERT W3FI63 PARMS TO W3FI72 PARMS
C W3FI71 MAKE ARRAY USED BY GRIB PACKER FOR GDS
C W3FI74 CONSTRUCT GRID DEFINITION SECTION (GDS)
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C
C$$$
INTEGER KGDS(200)
CHARACTER GDS(400)
INTEGER KPTR(200),KPDS(200),IPDS(200),IGDS(200)
DATA KPTR/200*0/,KPDS/200*0/
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C UNPACK GDS INTO KGDS
IF(IOPT.EQ.-1) THEN
CALL FI633(GDS,KPTR,KGDS,IRET)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C USE KGDS TO PACK GDS
ELSEIF(IOPT.EQ.255) THEN
CALL R63W72(KPDS,KGDS,IPDS,IGDS)
ICOMP=MOD(IGDS(8)/8,2)
CALL W3FI74(IGDS,ICOMP,GDS,LENGDS,NPTS,IRET)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C USE NCEP GRID ID TO MAKE GDS AND KGDS
ELSEIF(IOPT.GT.0.AND.IOPT.LT.255) THEN
CALL W3FI71(IOPT,IGDS,IRET)
IF(IRET.EQ.0) THEN
ICOMP=MOD(IGDS(8)/8,2)
CALL W3FI74(IGDS,ICOMP,GDS,LENGDS,NPTS,IRET)
IF(IRET.EQ.0) CALL FI633(GDS,KPTR,KGDS,IRET)
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END