ungrib build
[WPS.git] / ungrib / src / ngl / w3 / putgbens.f
blob6d01c137a3a92fab6fffc228403c57ea5669ac60
1 C-----------------------------------------------------------------------
2 SUBROUTINE PUTGBENS(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET)
3 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
5 C SUBPROGRAM: PUTGBENS PACKS AND WRITES A GRIB MESSAGE
6 C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01
8 C ABSTRACT: PACK AND WRITE A GRIB MESSAGE.
9 C THIS SUBPROGRAM IS NEARLY THE INVERSE OF GETGBENS.
10 C THIS OBSOLESCENT VERSION HAS BEEN REPLACED BY PUTGBE.
12 C PROGRAM HISTORY LOG:
13 C 94-04-01 IREDELL
14 C 95-10-31 IREDELL REMOVED SAVES AND PRINTS
16 C USAGE: CALL PUTGBENS(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET)
17 C INPUT ARGUMENTS:
18 C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
19 C KF INTEGER NUMBER OF DATA POINTS
20 C KPDS INTEGER (200) PDS PARAMETERS
21 C (1) - ID OF CENTER
22 C (2) - GENERATING PROCESS ID NUMBER
23 C (3) - GRID DEFINITION
24 C (4) - GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8)
25 C (5) - INDICATOR OF PARAMETER
26 C (6) - TYPE OF LEVEL
27 C (7) - HEIGHT/PRESSURE , ETC OF LEVEL
28 C (8) - YEAR INCLUDING (CENTURY-1)
29 C (9) - MONTH OF YEAR
30 C (10) - DAY OF MONTH
31 C (11) - HOUR OF DAY
32 C (12) - MINUTE OF HOUR
33 C (13) - INDICATOR OF FORECAST TIME UNIT
34 C (14) - TIME RANGE 1
35 C (15) - TIME RANGE 2
36 C (16) - TIME RANGE FLAG
37 C (17) - NUMBER INCLUDED IN AVERAGE
38 C (18) - VERSION NR OF GRIB SPECIFICATION
39 C (19) - VERSION NR OF PARAMETER TABLE
40 C (20) - NR MISSING FROM AVERAGE/ACCUMULATION
41 C (21) - CENTURY OF REFERENCE TIME OF DATA
42 C (22) - UNITS DECIMAL SCALE FACTOR
43 C (23) - SUBCENTER NUMBER
44 C (24) - PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS
45 C 128 IF FORECAST FIELD ERROR
46 C 64 IF BIAS CORRECTED FCST FIELD
47 C 32 IF SMOOTHED FIELD
48 C WARNING: CAN BE COMBINATION OF MORE THAN 1
49 C (25) - PDS BYTE 30, NOT USED
50 C KGDS INTEGER (200) GDS PARAMETERS
51 C (1) - DATA REPRESENTATION TYPE
52 C (19) - NUMBER OF VERTICAL COORDINATE PARAMETERS
53 C (20) - OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE
54 C PARAMETERS
55 C OR
56 C OCTET NUMBER OF THE LIST OF NUMBERS OF POINTS
57 C IN EACH ROW
58 C OR
59 C 255 IF NEITHER ARE PRESENT
60 C (21) - FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID
61 C (22) - NUMBER OF WORDS IN EACH ROW
62 C LATITUDE/LONGITUDE GRIDS
63 C (2) - N(I) NR POINTS ON LATITUDE CIRCLE
64 C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN
65 C (4) - LA(1) LATITUDE OF ORIGIN
66 C (5) - LO(1) LONGITUDE OF ORIGIN
67 C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
68 C (7) - LA(2) LATITUDE OF EXTREME POINT
69 C (8) - LO(2) LONGITUDE OF EXTREME POINT
70 C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT
71 C (10) - DJ LATITUDINAL DIRECTION INCREMENT
72 C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
73 C GAUSSIAN GRIDS
74 C (2) - N(I) NR POINTS ON LATITUDE CIRCLE
75 C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN
76 C (4) - LA(1) LATITUDE OF ORIGIN
77 C (5) - LO(1) LONGITUDE OF ORIGIN
78 C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
79 C (7) - LA(2) LATITUDE OF EXTREME POINT
80 C (8) - LO(2) LONGITUDE OF EXTREME POINT
81 C (9) - DI LONGITUDINAL DIRECTION OF INCREMENT
82 C (10) - N - NR OF CIRCLES POLE TO EQUATOR
83 C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
84 C (12) - NV - NR OF VERT COORD PARAMETERS
85 C (13) - PV - OCTET NR OF LIST OF VERT COORD PARAMETERS
86 C OR
87 C PL - LOCATION OF THE LIST OF NUMBERS OF POINTS IN
88 C EACH ROW (IF NO VERT COORD PARAMETERS
89 C ARE PRESENT
90 C OR
91 C 255 IF NEITHER ARE PRESENT
92 C POLAR STEREOGRAPHIC GRIDS
93 C (2) - N(I) NR POINTS ALONG LAT CIRCLE
94 C (3) - N(J) NR POINTS ALONG LON CIRCLE
95 C (4) - LA(1) LATITUDE OF ORIGIN
96 C (5) - LO(1) LONGITUDE OF ORIGIN
97 C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
98 C (7) - LOV GRID ORIENTATION
99 C (8) - DX - X DIRECTION INCREMENT
100 C (9) - DY - Y DIRECTION INCREMENT
101 C (10) - PROJECTION CENTER FLAG
102 C (11) - SCANNING MODE (RIGHT ADJ COPY OF OCTET 28)
103 C SPHERICAL HARMONIC COEFFICIENTS
104 C (2) - J PENTAGONAL RESOLUTION PARAMETER
105 C (3) - K " " "
106 C (4) - M " " "
107 C (5) - REPRESENTATION TYPE
108 C (6) - COEFFICIENT STORAGE MODE
109 C MERCATOR GRIDS
110 C (2) - N(I) NR POINTS ON LATITUDE CIRCLE
111 C (3) - N(J) NR POINTS ON LONGITUDE MERIDIAN
112 C (4) - LA(1) LATITUDE OF ORIGIN
113 C (5) - LO(1) LONGITUDE OF ORIGIN
114 C (6) - RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
115 C (7) - LA(2) LATITUDE OF LAST GRID POINT
116 C (8) - LO(2) LONGITUDE OF LAST GRID POINT
117 C (9) - LATIT - LATITUDE OF PROJECTION INTERSECTION
118 C (10) - RESERVED
119 C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
120 C (12) - LONGITUDINAL DIR GRID LENGTH
121 C (13) - LATITUDINAL DIR GRID LENGTH
122 C LAMBERT CONFORMAL GRIDS
123 C (2) - NX NR POINTS ALONG X-AXIS
124 C (3) - NY NR POINTS ALONG Y-AXIS
125 C (4) - LA1 LAT OF ORIGIN (LOWER LEFT)
126 C (5) - LO1 LON OF ORIGIN (LOWER LEFT)
127 C (6) - RESOLUTION (RIGHT ADJ COPY OF OCTET 17)
128 C (7) - LOV - ORIENTATION OF GRID
129 C (8) - DX - X-DIR INCREMENT
130 C (9) - DY - Y-DIR INCREMENT
131 C (10) - PROJECTION CENTER FLAG
132 C (11) - SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
133 C (12) - LATIN 1 - FIRST LAT FROM POLE OF SECANT CONE INTER
134 C (13) - LATIN 2 - SECOND LAT FROM POLE OF SECANT CONE INTER
135 C KENS INTEGER (200) ENSEMBLE PDS PARMS
136 C (1) - APPLICATION IDENTIFIER
137 C (2) - ENSEMBLE TYPE
138 C (3) - ENSEMBLE IDENTIFIER
139 C (4) - PRODUCT IDENTIFIER
140 C (5) - SMOOTHING FLAG
141 C LB LOGICAL*1 (KF) BITMAP IF PRESENT
142 C F REAL (KF) DATA
143 C OUTPUT ARGUMENTS:
144 C IRET INTEGER RETURN CODE
145 C 0 ALL OK
146 C OTHER W3FI72 GRIB PACKER RETURN CODE
148 C SUBPROGRAMS CALLED:
149 C PUTGBE PACK AND WRITE GRIB MESSAGE
151 C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
152 C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
154 C ATTRIBUTES:
155 C LANGUAGE: FORTRAN 77
156 C MACHINE: CRAY, WORKSTATIONS
158 C$$$
159 INTEGER KPDS(200),KGDS(200),KENS(200)
160 LOGICAL*1 LB(KF)
161 REAL F(KF)
162 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
163 PRINT *,'PLEASE USE PUTGBE RATHER THAN PUTGBENS'
164 CALL PUTGBE(LUGB,KF,KPDS,KGDS,KENS,LB,F,IRET)
165 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
166 RETURN