NCEPLIBS-w3emc  2.11.0
w3fi68.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Convert 25 word array to GRIB pds.
3 C> @author Ralph Jones @date 1991-05-08
4 
5 C> Converts an array of 25, or 27 integer words into a
6 C> grib product definition section (pds) of 28 bytes , or 30 bytes.
7 C> if pds bytes > 30, they are set to zero.
8 C>
9 C> Program history log:
10 C> - Ralph Jones 1991-05-08
11 C> - Ralph Jones 1992-09-25 Change to 25 words of input, level
12 C> can be in two words. (10,11)
13 C> - Ralph Jones 1993-01-08 Change for time range indicator if 10,
14 C> store time p1 in pds bytes 19-20.
15 C> - Ralph Jones 1993-01-26 Correction for fixed height above
16 C> ground level
17 C> - Ralph Jones 1993-03-29 Add save statement
18 C> - Bill Cavanaugh 1993-06-24 Modified program to allow for generation
19 C> of pds greater than 28 bytes (the desired
20 C> pds size is in id(1).
21 C> - Farley 1993-09-30 Change to allow for subcenter id; put
22 C> id(24) into pds(26).
23 C> - Ralph Jones 1993-10-12 Changes for on388 rev. oct 9,1993, new
24 C> levels 125, 200, 201.
25 C> - Ralph Jones 1994-02-23 Take out sbytes, replace with do loop
26 C> - Ralph Jones 1994-04-14 Changes for on388 rev. mar 24,1994, new
27 C> levels 115,116.
28 C> - Ralph Jones 1994-12-04 Change to add id words 26, 27 for pds
29 C> bytes 29 and 30.
30 C> - Ralph Jones 1995-09-07 Change for new level 117, 119.
31 C> - Mark Iredell 1995-10-31 REmoved saves and prints
32 C> - Ebisuzaki 1998-06-30 Linux port
33 C> - Stephen Gilbert 2001-06-05 Changed fortran intrinsic function OR() to
34 C> f90 standard intrinsic IOR().
35 C> - Mark Iredell 2003-02-25 Recognize level type 126
36 C> - D. C. Stokes 2005-05-06 Recognize level types 235, 237, 238
37 C>
38 C> @param[in] ID 25,27 word integer array.
39 C> @param[out] PDS 28 30 or greater character pds for edition 1.
40 C>
41 C> @note Layout of 'id' array:
42 C> - ID(1) = Number of bytes in product definition section (pds)
43 C> - ID(2) = Parameter table version number
44 C> - ID(3) = Identification of originating center
45 C> - ID(4) = Model identification (allocated by originating center)
46 C> - ID(5) = Grid identification
47 C> - ID(6) = 0 if no gds section, 1 if gds section is included
48 C> - ID(7) = 0 if no bms section, 1 if bms section is included
49 C> - ID(8) = Indicator of parameter and units (table 2)
50 C> - ID(9) = Indicator of type of level (table 3)
51 C> - ID(10) = Value 1 of level (0 for 1-100,102,103,105,107
52 C> 109,111,113,115,117,119,125,126,160,200,201,235,237,238
53 C> level is in id word 11)
54 C> - ID(11) = Value 2 of level
55 C> - ID(12) = Year of century
56 C> - ID(13) = Month of year
57 C> - ID(14) = Day of month
58 C> - ID(15) = Hour of day
59 C> - ID(16) = Minute of hour (in most cases set to 0)
60 C> - ID(17) = Fcst time unit
61 C> - ID(18) = P1 period of time
62 C> - ID(19) = P2 period of time
63 C> - ID(20) = Time range indicator
64 C> - ID(21) = Number included in average
65 C> - ID(22) = Number missing from averages
66 C> - ID(23) = Century (20, change to 21 on jan. 1, 2001)
67 C> - ID(24) = Subcenter identification
68 C> - ID(25) = Scaling power of 10
69 C> - ID(26) = Flag byte, 8 on/off flags
70 C> |BIT NUMBER |VALUE |ID(26) | DEFINITION|
71 C> | :--------- | :--- | :--- | : ----------- |
72 C> |1 |0 |0 |FULL FCST FIELD|
73 C> | |1 |128 |FCST ERROR FIELD|
74 C> |2 |0 |0 |ORIGINAL FCST FIELD|
75 C> | |1 |64 |BIAS CORRECTED FCST FIELD|
76 C> |3 |0 |0 |ORIGINAL RESOLUTION RETAINED|
77 C> | |1 |32 |SMOOTHED FIELD|
78 C> @note ID(26) can be the sum of bits 1, 2, 3.
79 C> bits 4-8 not used, set to zero
80 C> if ID(1) is 28, you do not need ID(26) and ID(27).
81 C> - ID(27) = unused, set to 0 so pds byte 30 is set to zero.
82 C>
83 C> @author Ralph Jones @date 1991-05-08
84  SUBROUTINE w3fi68 (ID, PDS)
85 C
86  INTEGER ID(*)
87 C
88  CHARACTER * 1 PDS(*)
89 C
90  pds(1) = char(mod(id(1)/65536,256))
91  pds(2) = char(mod(id(1)/256,256))
92  pds(3) = char(mod(id(1),256))
93  pds(4) = char(id(2))
94  pds(5) = char(id(3))
95  pds(6) = char(id(4))
96  pds(7) = char(id(5))
97  i = 0
98  if (id(6).ne.0) i = i + 128
99  if (id(7).ne.0) i = i + 64
100  pds(8) = char(i)
101 
102  pds(9) = char(id(8))
103  pds(10) = char(id(9))
104  i9 = id(9)
105 C
106 C TEST TYPE OF LEVEL TO SEE IF LEVEL IS IN TWO
107 C WORDS OR ONE
108 C
109  IF ((i9.GE.1.AND.i9.LE.100).OR.i9.EQ.102.OR.
110  & i9.EQ.103.OR.i9.EQ.105.OR.i9.EQ.107.OR.
111  & i9.EQ.109.OR.i9.EQ.111.OR.i9.EQ.113.OR.
112  & i9.EQ.115.OR.i9.EQ.117.OR.i9.EQ.119.OR.
113  & i9.EQ.125.OR.i9.EQ.126.OR.i9.EQ.160.OR.
114  & i9.EQ.200.OR.i9.EQ.201.OR.i9.EQ.235.OR.
115  & i9.EQ.237.OR.i9.EQ.238) THEN
116  level = id(11)
117  IF (level.LT.0) THEN
118  level = - level
119  level = ior(level,32768)
120  END IF
121  pds(11) = char(mod(level/256,256))
122  pds(12) = char(mod(level,256))
123  ELSE
124  pds(11) = char(id(10))
125  pds(12) = char(id(11))
126  END IF
127  pds(13) = char(id(12))
128  pds(14) = char(id(13))
129  pds(15) = char(id(14))
130  pds(16) = char(id(15))
131  pds(17) = char(id(16))
132  pds(18) = char(id(17))
133 C
134 C TEST TIME RANGE INDICATOR (PDS BYTE 21) FOR 10
135 C IF SO PUT TIME P1 IN PDS BYTES 19-20.
136 C
137  IF (id(20).EQ.10) THEN
138  pds(19) = char(mod(id(18)/256,256))
139  pds(20) = char(mod(id(18),256))
140  ELSE
141  pds(19) = char(id(18))
142  pds(20) = char(id(19))
143  END IF
144  pds(21) = char(id(20))
145  pds(22) = char(mod(id(21)/256,256))
146  pds(23) = char(mod(id(21),256))
147  pds(24) = char(id(22))
148  pds(25) = char(id(23))
149  pds(26) = char(id(24))
150  iscale = id(25)
151  IF (iscale.LT.0) THEN
152  iscale = -iscale
153  iscale = ior(iscale,32768)
154  END IF
155  pds(27) = char(mod(iscale/256,256))
156  pds(28) = char(mod(iscale ,256))
157  IF (id(1).GT.28) THEN
158  pds(29) = char(id(26))
159  pds(30) = char(id(27))
160  END IF
161 C
162 C SET PDS 31-?? TO ZERO
163 C
164  IF (id(1).GT.30) THEN
165  k = id(1)
166  DO i = 31,k
167  pds(i) = char(0)
168  END DO
169  END IF
170 C
171  RETURN
172  END
w3fi68
subroutine w3fi68(ID, PDS)
Converts an array of 25, or 27 integer words into a grib product definition section (pds) of 28 bytes...
Definition: w3fi68.f:85