1module codtyp_mod
2 ! MODULE codtyp_mod (prefix='codtyp' category='8. Low-level utilities and constants')
3 !
4 !:Purpose: To read a list of codtype definitions (codes that define various
5 ! types of observations) from the namelist and to make them available
6 ! through functions.
7 !
8 ! Definitions are taken from:
9 ! https://wiki.cmc.ec.gc.ca/wiki/Description_exhaustive_du_format_BURP
10 !
11 use utilities_mod
12 use midasMpi_mod
13 private
14
15 integer ,parameter :: codtyp_maxNumber = 256
16 integer, parameter :: codtyp_name_length = 21
17 integer :: ncodtyp
18 logical :: initialized=.false.
19
20 ! namelist variables
21 character(len=codtyp_name_length) :: cnames(codtyp_maxNumber) ! names for new additions to standard codtype list
22 integer :: icod (codtyp_maxNumber) ! codes for new additions to standard codtype list
23 namelist /NAMCODTYP/ cnames, icod
24
25 ! public variables (parameters)
26 public :: codtyp_name_length, codtyp_maxNumber
27
28 ! public procedures
29 public :: codtyp_get_codtyp, codtyp_get_name
30
31contains
32
33 subroutine codtyp_initialize()
34 !
35 !:Purpose: To initialize the NAMCODTYP namelist variables
36 !
37 implicit none
38
39 ! Locals:
40 integer :: nulnam,ierr,i,ilen
41 character (len=codtyp_name_length) :: ctempo
42 integer, external :: fnom,fclos
43
44 ! set default values for namelist variables
45 ncodtyp = 0
46 cnames(:) = "XXXXXXXXXXXXXXXXXXXX"
47 icod(:) = -1
48
49 ! read namelist to obtain additions to codtype dictionary
50 if (utl_isNamelistPresent('namcodtyp','./flnml')) then
51 nulnam=0
52 ierr=fnom(nulnam,'./flnml','FTN+SEQ+R/O',0)
53 read(nulnam,nml=namcodtyp,iostat=ierr)
54 if (ierr /= 0) call utl_abort('codtyp_initialize: Error reading namelist namcodtyp')
55 ierr=fclos(nulnam)
56 else
57 write(*,*)
58 write(*,*) 'codtyp_initialize: namcodtyp is missing in the namelist. The default value will be taken.'
59 end if
60
61 ! count how many additions were read and ensure lower case
62 do i = 1, codtyp_maxNumber
63 if (icod(i) == -1 ) then
64 ncodtyp = i - 1
65 exit
66 endif
67 ilen = len_trim(cnames(i))
68 call up2low(cnames(i)(1:ilen),ctempo(1:ilen))
69 cnames(i)(1:ilen) = ctempo(1:ilen)
70 enddo
71
72 cnames(1 + ncodtyp) = 'synopnonauto'
73 icod(1 + ncodtyp) = 12
74 cnames(2 + ncodtyp) = 'shipnonauto'
75 icod(2 + ncodtyp) = 13
76 cnames(3 + ncodtyp) = 'synopmobil'
77 icod(3 + ncodtyp) = 14
78 cnames(4 + ncodtyp) = 'metar'
79 icod(4 + ncodtyp) = 15
80 cnames(5 + ncodtyp) = 'speci'
81 icod(5 + ncodtyp) = 16
82 cnames(6 + ncodtyp) = 'drifter'
83 icod(6 + ncodtyp) = 18
84 cnames(7 + ncodtyp) = 'radob'
85 icod(7 + ncodtyp) = 20
86 cnames(8 + ncodtyp) = 'radprep'
87 icod(8 + ncodtyp) = 22
88 cnames(9 + ncodtyp) = 'pilot'
89 icod(9 + ncodtyp) = 32
90 cnames(10 + ncodtyp) = 'pilotship'
91 icod(10 + ncodtyp) = 33
92 cnames(11 + ncodtyp) = 'pilotmobil'
93 icod(11 + ncodtyp) = 34
94 cnames(12 + ncodtyp) = 'temp'
95 icod(12 + ncodtyp) = 35
96 cnames(13 + ncodtyp) = 'tempship'
97 icod(13 + ncodtyp) = 36
98 cnames(14 + ncodtyp) = 'tempdrop'
99 icod(14 + ncodtyp) = 37
100 cnames(15 + ncodtyp) = 'tempmobil'
101 icod(15 + ncodtyp) = 38
102 cnames(16 + ncodtyp) = 'rocob'
103 icod(16 + ncodtyp) = 39
104 cnames(17 + ncodtyp) = 'rocobship'
105 icod(17 + ncodtyp) = 40
106 cnames(18 + ncodtyp) = 'codar'
107 icod(18 + ncodtyp) = 41
108 cnames(19 + ncodtyp) = 'amdar'
109 icod(19 + ncodtyp) = 42
110 cnames(20 + ncodtyp) = 'icean'
111 icod(20 + ncodtyp) = 44
112 cnames(21 + ncodtyp) = 'iac'
113 icod(21 + ncodtyp) = 45
114 cnames(22 + ncodtyp) = 'iacfleet'
115 icod(22 + ncodtyp) = 46
116 cnames(23 + ncodtyp) = 'grid'
117 icod(23 + ncodtyp) = 47
118 cnames(24 + ncodtyp) = 'graf'
119 icod(24 + ncodtyp) = 49
120 cnames(25 + ncodtyp) = 'wintem'
121 icod(25 + ncodtyp) = 50
122 cnames(26 + ncodtyp) = 'taf'
123 icod(26 + ncodtyp) = 51
124 cnames(27 + ncodtyp) = 'arfor'
125 icod(27 + ncodtyp) = 53
126 cnames(28 + ncodtyp) = 'rofor'
127 icod(28 + ncodtyp) = 54
128 cnames(29 + ncodtyp) = 'radof'
129 icod(29 + ncodtyp) = 57
130 cnames(30 + ncodtyp) = 'mafor'
131 icod(30 + ncodtyp) = 61
132 cnames(31 + ncodtyp) = 'trackob'
133 icod(31 + ncodtyp) = 62
134 cnames(32 + ncodtyp) = 'bathy'
135 icod(32 + ncodtyp) = 63
136 cnames(33 + ncodtyp) = 'tesac'
137 icod(33 + ncodtyp) = 64
138 cnames(34 + ncodtyp) = 'waveob'
139 icod(34 + ncodtyp) = 65
140 cnames(35 + ncodtyp) = 'hydra'
141 icod(35 + ncodtyp) = 67
142 cnames(36 + ncodtyp) = 'hyfor'
143 icod(36 + ncodtyp) = 68
144 cnames(37 + ncodtyp) = 'climat'
145 icod(37 + ncodtyp) = 71
146 cnames(38 + ncodtyp) = 'climatship'
147 icod(38 + ncodtyp) = 72
148 cnames(39 + ncodtyp) = 'nacli'
149 icod(39 + ncodtyp) = 73
150 cnames(40 + ncodtyp) = 'climattemp'
151 icod(40 + ncodtyp) = 75
152 cnames(41 + ncodtyp) = 'climattempship'
153 icod(41 + ncodtyp) = 76
154 cnames(42 + ncodtyp) = 'sfazi'
155 icod(42 + ncodtyp) = 81
156 cnames(43 + ncodtyp) = 'sfloc'
157 icod(43 + ncodtyp) = 82
158 cnames(44 + ncodtyp) = 'sfazu'
159 icod(44 + ncodtyp) = 83
160 cnames(45 + ncodtyp) = 'sarep'
161 icod(45 + ncodtyp) = 85
162 cnames(46 + ncodtyp) = 'satem'
163 icod(46 + ncodtyp) = 86
164 cnames(47 + ncodtyp) = 'sarad'
165 icod(47 + ncodtyp) = 87
166 cnames(48 + ncodtyp) = 'satob'
167 icod(48 + ncodtyp) = 88
168 cnames(49 + ncodtyp) = 'grib'
169 icod(49 + ncodtyp) = 92
170 cnames(50 + ncodtyp) = 'bufr'
171 icod(50 + ncodtyp) = 94
172 cnames(51 + ncodtyp) = 'sfcaq'
173 icod(51 + ncodtyp) = 127
174 cnames(52 + ncodtyp) = 'airep'
175 icod(52 + ncodtyp) = 128
176 cnames(53 + ncodtyp) = 'pirep'
177 icod(53 + ncodtyp) = 129
178 cnames(54 + ncodtyp) = 'profwind'
179 icod(54 + ncodtyp) = 130
180 cnames(55 + ncodtyp) = 'synopsuperob'
181 icod(55 + ncodtyp) = 131
182 cnames(56 + ncodtyp) = 'airepsuperob'
183 icod(56 + ncodtyp) = 132
184 cnames(57 + ncodtyp) = 'sasynop'
185 icod(57 + ncodtyp) = 133
186 cnames(58 + ncodtyp) = 'paobs'
187 icod(58 + ncodtyp) = 134
188 cnames(59 + ncodtyp) = 'temppilot'
189 icod(59 + ncodtyp) = 135
190 cnames(60 + ncodtyp) = 'tempsynop'
191 icod(60 + ncodtyp) = 136
192 cnames(61 + ncodtyp) = 'pilotsynop'
193 icod(61 + ncodtyp) = 137
194 cnames(62 + ncodtyp) = 'temppilotsynop'
195 icod(62 + ncodtyp) = 138
196 cnames(63 + ncodtyp) = 'temppilotship'
197 icod(63 + ncodtyp) = 139
198 cnames(64 + ncodtyp) = 'tempshipship'
199 icod(64 + ncodtyp) = 140
200 cnames(65 + ncodtyp) = 'tempsshipship'
201 icod(65 + ncodtyp) = 141
202 cnames(66 + ncodtyp) = 'pilotshipship'
203 icod(66 + ncodtyp) = 142
204 cnames(67 + ncodtyp) = 'saswobnonauto'
205 icod(67 + ncodtyp) = 143
206 cnames(68 + ncodtyp) = 'saswobauto'
207 icod(68 + ncodtyp) = 144
208 cnames(69 + ncodtyp) = 'synoppatrol'
209 icod(69 + ncodtyp) = 145
210 cnames(70 + ncodtyp) = 'asynopauto'
211 icod(70 + ncodtyp) = 146
212 cnames(71 + ncodtyp) = 'ashipauto'
213 icod(71 + ncodtyp) = 147
214 cnames(72 + ncodtyp) = 'saswobnonautospecial'
215 icod(72 + ncodtyp) = 148
216 cnames(73 + ncodtyp) = 'saswobautospecial'
217 icod(73 + ncodtyp) = 149
218 cnames(74 + ncodtyp) = 'pseudosfc'
219 icod(74 + ncodtyp) = 150
220 cnames(75 + ncodtyp) = 'pseudoalt'
221 icod(75 + ncodtyp) = 151
222 cnames(76 + ncodtyp) = 'pseudosfcrep'
223 icod(76 + ncodtyp) = 152
224 cnames(77 + ncodtyp) = 'pseudoaltrep'
225 icod(77 + ncodtyp) = 153
226 cnames(78 + ncodtyp) = 'acars'
227 icod(78 + ncodtyp) = 157
228 cnames(79 + ncodtyp) = 'humsat'
229 icod(79 + ncodtyp) = 158
230 cnames(80 + ncodtyp) = 'temppilotmobil'
231 icod(80 + ncodtyp) = 159
232 cnames(81 + ncodtyp) = 'tempsynopmobil'
233 icod(81 + ncodtyp) = 160
234 cnames(82 + ncodtyp) = 'pilotsynopmobil'
235 icod(82 + ncodtyp) = 161
236 cnames(83 + ncodtyp) = 'temppilotsynopmobil'
237 icod(83 + ncodtyp) = 162
238 cnames(84 + ncodtyp) = 'radar'
239 icod(84 + ncodtyp) = 163
240 cnames(85 + ncodtyp) = 'amsua'
241 icod(85 + ncodtyp) = 164
242 cnames(86 + ncodtyp) = 'scat'
243 icod(86 + ncodtyp) = 167
244 cnames(87 + ncodtyp) = 'ssmi'
245 icod(87 + ncodtyp) = 168
246 cnames(88 + ncodtyp) = 'ro'
247 icod(88 + ncodtyp) = 169
248 cnames(89 + ncodtyp) = 'ozone'
249 icod(89 + ncodtyp) = 170
250 cnames(90 + ncodtyp) = 'meteosat'
251 icod(90 + ncodtyp) = 171
252 cnames(91 + ncodtyp) = 'shef'
253 icod(91 + ncodtyp) = 172
254 cnames(92 + ncodtyp) = 'sar'
255 icod(92 + ncodtyp) = 174
256 cnames(93 + ncodtyp) = 'altim'
257 icod(93 + ncodtyp) = 175
258 cnames(94 + ncodtyp) = 'ads'
259 icod(94 + ncodtyp) = 177
260 cnames(95 + ncodtyp) = 'iceclake'
261 icod(95 + ncodtyp) = 178
262 cnames(96 + ncodtyp) = 'icecocean'
263 icod(96 + ncodtyp) = 179
264 cnames(97 + ncodtyp) = 'goes'
265 icod(97 + ncodtyp) = 180
266 cnames(98 + ncodtyp) = 'amsub'
267 icod(98 + ncodtyp) = 181
268 cnames(99 + ncodtyp) = 'mhs'
269 icod(99 + ncodtyp) = 182
270 cnames(100 + ncodtyp) = 'airs'
271 icod(100 + ncodtyp) = 183
272 cnames(101 + ncodtyp) = 'radiance'
273 icod(101 + ncodtyp) = 184
274 cnames(102 + ncodtyp) = 'radianceclear'
275 icod(102 + ncodtyp) = 185
276 cnames(103 + ncodtyp) = 'iasi'
277 icod(103 + ncodtyp) = 186
278 cnames(104 + ncodtyp) = 'windsbufr'
279 icod(104 + ncodtyp) = 188
280 cnames(105 + ncodtyp) = 'gpssfc'
281 icod(105 + ncodtyp) = 189
282 cnames(106 + ncodtyp) = 'atms'
283 icod(106 + ncodtyp) = 192
284 cnames(107 + ncodtyp) = 'cris'
285 icod(107 + ncodtyp) = 193
286 cnames(108 + ncodtyp) = 'smossmap'
287 icod(108 + ncodtyp) = 194
288 cnames(109 + ncodtyp) = 'chemremote'
289 icod(109 + ncodtyp) = 195
290 cnames(110 + ncodtyp) = 'cheminsitu'
291 icod(110 + ncodtyp) = 196
292 cnames(111 + ncodtyp) = 'ascat'
293 icod(111 + ncodtyp) = 254
294 cnames(112 + ncodtyp) = 'ssmis'
295 icod(112 + ncodtyp) = 168
296 cnames(113 + ncodtyp) = 'crisfsr'
297 icod(113 + ncodtyp) = 202
298 cnames(114 + ncodtyp) = 'mwhs2'
299 icod(114 + ncodtyp) = 200
300 cnames(115 + ncodtyp) = 'sarwinds'
301 icod(115 + ncodtyp) = 204
302
303 ncodtyp = ncodtyp + 115
304
305 if (mmpi_myid == 0) write(*,nml=namcodtyp)
306
307 initialized = .true.
308
309 end subroutine codtyp_initialize
310
311 integer function codtyp_get_codtyp(name)
312 !
313 !:Purpose: Given a family name, return the codtyp
314 !
315 ! NEW information from namelist NAMCODTYP
316 !
317 implicit none
318
319 ! Arguments:
320 character (len=*),intent(in) :: name
321
322 ! Locals:
323 integer :: i, ilen
324 character (len=codtyp_name_length) :: ctempo
325
326 if (.not.initialized) call codtyp_initialize()
327
328 ! find the codtype based on the name
329 ctempo(:) = ' '
330 codtyp_get_codtyp = -1
331 ilen = len_trim(name)
332 call up2low(name(1:ilen),ctempo(1:ilen))
333 do i=1, ncodtyp
334 if ( trim(ctempo) == trim(cnames(i)) ) then
335 codtyp_get_codtyp = icod(i)
336 exit
337 end if
338 end do
339
340 end function codtyp_get_codtyp
341
342 character(len=codtyp_name_length) function codtyp_get_name(codtyp)
343 !
344 !:Purpose: Given a codtyp, return the family name
345 !
346 ! NEW information from namelist NAMCODTYP
347 !
348 implicit none
349
350 ! Arguments:
351 integer, intent(in) :: codtyp
352
353 ! Locals:
354 integer :: i
355
356 if (.not.initialized) call codtyp_initialize()
357
358 do i=1, ncodtyp
359 if ( icod(i) == codtyp ) then
360 codtyp_get_name = trim(cnames(i))
361 exit
362 end if
363 end do
364
365 end function codtyp_get_name
366
367end module codtyp_mod
