module_optional_si_input.F
References to this file elsewhere.
1 MODULE module_optional_si_input
2
3 INTEGER :: flag_metgrid , flag_tavgsfc , flag_psfc , flag_soilhgt
4
5 INTEGER :: flag_qv , flag_qc , flag_qr , flag_qi , flag_qs , &
6 flag_qg , flag_qni
7
8 INTEGER :: flag_st000010 , flag_st010040 , flag_st040100 , flag_st100200 , flag_st010200 , &
9 flag_sm000010 , flag_sm010040 , flag_sm040100 , flag_sm100200 , flag_sm010200 , &
10 flag_sw000010 , flag_sw010040 , flag_sw040100 , flag_sw100200 , flag_sw010200
11
12 INTEGER :: flag_st000007 , flag_st007028 , flag_st028100 , flag_st100255 , &
13 flag_sm000007 , flag_sm007028 , flag_sm028100 , flag_sm100255
14
15 INTEGER :: flag_soilt000 , flag_soilt005 , flag_soilt020 , flag_soilt040 , flag_soilt160 , flag_soilt300 , &
16 flag_soilm000 , flag_soilm005 , flag_soilm020 , flag_soilm040 , flag_soilm160 , flag_soilm300 , &
17 flag_soilw000 , flag_soilw005 , flag_soilw020 , flag_soilw040 , flag_soilw160 , flag_soilw300
18
19 INTEGER :: flag_sst , flag_toposoil , flag_snowh
20
21 INTEGER :: num_st_levels_input , num_sm_levels_input , num_sw_levels_input
22 INTEGER :: num_st_levels_alloc , num_sm_levels_alloc , num_sw_levels_alloc
23 INTEGER , DIMENSION(100) :: st_levels_input , sm_levels_input , sw_levels_input
24 REAL , ALLOCATABLE , DIMENSION(:,:,:) :: st_input , sm_input , sw_input
25
26 CHARACTER (LEN=8) , PRIVATE :: flag_name
27
28 LOGICAL :: already_been_here
29
30 CONTAINS
31
32 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
33
34 SUBROUTINE init_module_optional_si_input ( grid , config_flags )
35
36 USE module_domain
37 USE module_configure
38
39 IMPLICIT NONE
40
41 TYPE ( domain ) :: grid
42 TYPE (grid_config_rec_type) :: config_flags
43
44 INTEGER :: ids, ide, jds, jde, kds, kde, &
45 ims, ime, jms, jme, kms, kme, &
46 its, ite, jts, jte, kts, kte
47
48 ! Get the various indices, assume XZY ordering.
49
50 ids = grid%sd31 ; ide = grid%ed31 ;
51 kds = grid%sd32 ; kde = grid%ed32 ;
52 jds = grid%sd33 ; jde = grid%ed33 ;
53
54 ims = grid%sm31 ; ime = grid%em31 ;
55 kms = grid%sm32 ; kme = grid%em32 ;
56 jms = grid%sm33 ; jme = grid%em33 ;
57
58 its = grid%sp31 ; ite = grid%ep31 ; ! note that tile is entire patch
59 kts = grid%sp32 ; kte = grid%ep32 ; ! note that tile is entire patch
60 jts = grid%sp33 ; jte = grid%ep33 ; ! note that tile is entire patch
61
62 IF ( .NOT. already_been_here ) THEN
63
64 num_st_levels_alloc = config_flags%num_soil_layers * 3 ! used to be 2
65 num_sm_levels_alloc = config_flags%num_soil_layers * 3
66 num_sw_levels_alloc = config_flags%num_soil_layers * 3
67
68 IF ( ALLOCATED ( st_input ) ) DEALLOCATE ( st_input )
69 IF ( ALLOCATED ( sm_input ) ) DEALLOCATE ( sm_input )
70 IF ( ALLOCATED ( sw_input ) ) DEALLOCATE ( sw_input )
71
72 ALLOCATE ( st_input(ims:ime,num_st_levels_alloc,jms:jme) )
73 ALLOCATE ( sm_input(ims:ime,num_sm_levels_alloc,jms:jme) )
74 ALLOCATE ( sw_input(ims:ime,num_sw_levels_alloc,jms:jme) )
75
76 END IF
77
78 already_been_here = .TRUE.
79
80 END SUBROUTINE init_module_optional_si_input
81
82 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
83
84 SUBROUTINE optional_si_input ( grid , fid )
85
86 USE module_configure
87 USE module_domain
88
89 IMPLICIT NONE
90
91 TYPE ( domain ) :: grid
92 INTEGER , INTENT(IN) :: fid
93
94 INTEGER :: ids, ide, jds, jde, kds, kde, &
95 ims, ime, jms, jme, kms, kme, &
96 its, ite, jts, jte, kts, kte
97
98 ! Get the various indices, assume XZY ordering.
99
100 ids = grid%sd31 ; ide = grid%ed31 ;
101 kds = grid%sd32 ; kde = grid%ed32 ;
102 jds = grid%sd33 ; jde = grid%ed33 ;
103
104 ims = grid%sm31 ; ime = grid%em31 ;
105 kms = grid%sm32 ; kme = grid%em32 ;
106 jms = grid%sm33 ; jme = grid%em33 ;
107
108 its = grid%sp31 ; ite = grid%ep31 ; ! note that tile is entire patch
109 kts = grid%sp32 ; kte = grid%ep32 ; ! note that tile is entire patch
110 jts = grid%sp33 ; jte = grid%ep33 ; ! note that tile is entire patch
111
112
113 CALL optional_tavgsfc ( grid , fid , &
114 ids, ide, jds, jde, kds, kde, &
115 ims, ime, jms, jme, kms, kme, &
116 its, ite, jts, jte, kts, kte )
117
118 CALL optional_moist ( grid , fid , &
119 ids, ide, jds, jde, kds, kde, &
120 ims, ime, jms, jme, kms, kme, &
121 its, ite, jts, jte, kts, kte )
122
123 CALL optional_metgrid ( grid , fid , &
124 ids, ide, jds, jde, kds, kde, &
125 ims, ime, jms, jme, kms, kme, &
126 its, ite, jts, jte, kts, kte )
127
128 CALL optional_sst ( grid , fid , &
129 ids, ide, jds, jde, kds, kde, &
130 ims, ime, jms, jme, kms, kme, &
131 its, ite, jts, jte, kts, kte )
132
133 CALL optional_snowh ( grid , fid , &
134 ids, ide, jds, jde, kds, kde, &
135 ims, ime, jms, jme, kms, kme, &
136 its, ite, jts, jte, kts, kte )
137
138 IF ( ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .OR. &
139 ( model_config_rec%sf_surface_physics(grid%id) .EQ. 2 ) .OR. &
140 ( model_config_rec%sf_surface_physics(grid%id) .EQ. 3 ) .OR. &
141 ( model_config_rec%sf_surface_physics(grid%id) .EQ. 99 ) ) THEN
142
143 CALL optional_lsm ( grid , fid , &
144 ids, ide, jds, jde, kds, kde, &
145 ims, ime, jms, jme, kms, kme, &
146 its, ite, jts, jte, kts, kte )
147
148 CALL optional_lsm_levels ( grid , fid , &
149 ids, ide, jds, jde, kds, kde, &
150 ims, ime, jms, jme, kms, kme, &
151 its, ite, jts, jte, kts, kte )
152 END IF
153
154 END SUBROUTINE optional_si_input
155
156 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
157
158 SUBROUTINE optional_moist ( grid , fid , &
159 ids, ide, jds, jde, kds, kde, &
160 ims, ime, jms, jme, kms, kme, &
161 its, ite, jts, jte, kts, kte )
162
163 USE module_io_wrf
164 USE module_domain
165
166 USE module_configure
167 USE module_io_domain
168
169 IMPLICIT NONE
170
171 TYPE ( domain ) :: grid
172 INTEGER , INTENT(IN) :: fid
173
174 INTEGER :: ids, ide, jds, jde, kds, kde, &
175 ims, ime, jms, jme, kms, kme, &
176 its, ite, jts, jte, kts, kte
177
178 INTEGER :: itmp , icnt , ierr
179
180 flag_qv = 0
181 flag_qc = 0
182 flag_qr = 0
183 flag_qi = 0
184 flag_qs = 0
185 flag_qg = 0
186 flag_qni = 0
187
188 flag_name(1:8) = 'QV '
189 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
190 IF ( ierr .EQ. 0 ) THEN
191 flag_qv = itmp
192 END IF
193 flag_name(1:8) = 'QC '
194 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
195 IF ( ierr .EQ. 0 ) THEN
196 flag_qc = itmp
197 END IF
198 flag_name(1:8) = 'QR '
199 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
200 IF ( ierr .EQ. 0 ) THEN
201 flag_qr = itmp
202 END IF
203 flag_name(1:8) = 'QI '
204 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
205 IF ( ierr .EQ. 0 ) THEN
206 flag_qi = itmp
207 END IF
208 flag_name(1:8) = 'QS '
209 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
210 IF ( ierr .EQ. 0 ) THEN
211 flag_qs = itmp
212 END IF
213 flag_name(1:8) = 'QG '
214 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
215 IF ( ierr .EQ. 0 ) THEN
216 flag_qg = itmp
217 END IF
218 flag_name(1:8) = 'QNI '
219 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
220 IF ( ierr .EQ. 0 ) THEN
221 flag_qni = itmp
222 END IF
223
224 END SUBROUTINE optional_moist
225
226 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
227
228 SUBROUTINE optional_metgrid ( grid , fid , &
229 ids, ide, jds, jde, kds, kde, &
230 ims, ime, jms, jme, kms, kme, &
231 its, ite, jts, jte, kts, kte )
232
233 USE module_io_wrf
234 USE module_domain
235 USE module_configure
236 USE module_io_domain
237
238 IMPLICIT NONE
239
240 TYPE ( domain ) :: grid
241 INTEGER , INTENT(IN) :: fid
242
243 INTEGER :: ids, ide, jds, jde, kds, kde, &
244 ims, ime, jms, jme, kms, kme, &
245 its, ite, jts, jte, kts, kte
246
247 INTEGER :: itmp , icnt , ierr
248
249 flag_metgrid = 0
250
251 flag_name(1:8) = 'METGRID '
252 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
253 IF ( ierr .EQ. 0 ) THEN
254 flag_metgrid = itmp
255 END IF
256
257 END SUBROUTINE optional_metgrid
258
259 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
260
261 SUBROUTINE optional_sst ( grid , fid , &
262 ids, ide, jds, jde, kds, kde, &
263 ims, ime, jms, jme, kms, kme, &
264 its, ite, jts, jte, kts, kte )
265
266 USE module_io_wrf
267 USE module_domain
268 USE module_configure
269 USE module_io_domain
270
271 IMPLICIT NONE
272
273 TYPE ( domain ) :: grid
274 INTEGER , INTENT(IN) :: fid
275
276 INTEGER :: ids, ide, jds, jde, kds, kde, &
277 ims, ime, jms, jme, kms, kme, &
278 its, ite, jts, jte, kts, kte
279
280 INTEGER :: itmp , icnt , ierr
281
282 flag_sst = 0
283
284 flag_name(1:8) = 'SST '
285 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
286 IF ( ierr .EQ. 0 ) THEN
287 flag_sst = itmp
288 END IF
289
290 END SUBROUTINE optional_sst
291
292
293 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
294
295 SUBROUTINE optional_tavgsfc ( grid , fid , &
296 ids, ide, jds, jde, kds, kde, &
297 ims, ime, jms, jme, kms, kme, &
298 its, ite, jts, jte, kts, kte )
299
300 USE module_io_wrf
301 USE module_domain
302 USE module_configure
303 USE module_io_domain
304
305 IMPLICIT NONE
306
307 TYPE ( domain ) :: grid
308 INTEGER , INTENT(IN) :: fid
309
310 INTEGER :: ids, ide, jds, jde, kds, kde, &
311 ims, ime, jms, jme, kms, kme, &
312 its, ite, jts, jte, kts, kte
313
314 INTEGER :: itmp , icnt , ierr
315
316 flag_tavgsfc = 0
317
318 flag_name(1:8) = 'TAVGSFC '
319 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
320 IF ( ierr .EQ. 0 ) THEN
321 flag_tavgsfc = itmp
322 END IF
323
324 END SUBROUTINE optional_tavgsfc
325
326 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
327
328 SUBROUTINE optional_snowh ( grid , fid , &
329 ids, ide, jds, jde, kds, kde, &
330 ims, ime, jms, jme, kms, kme, &
331 its, ite, jts, jte, kts, kte )
332
333 USE module_io_wrf
334 USE module_domain
335 USE module_configure
336 USE module_io_domain
337
338 IMPLICIT NONE
339
340 TYPE ( domain ) :: grid
341 INTEGER , INTENT(IN) :: fid
342
343 INTEGER :: ids, ide, jds, jde, kds, kde, &
344 ims, ime, jms, jme, kms, kme, &
345 its, ite, jts, jte, kts, kte
346
347 INTEGER :: itmp , icnt , ierr
348
349 flag_snowh = 0
350
351 flag_name(1:8) = 'SNOWH '
352 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
353 IF ( ierr .EQ. 0 ) THEN
354 flag_snowh = itmp
355 END IF
356
357 END SUBROUTINE optional_snowh
358
359 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
360
361 SUBROUTINE optional_lsm ( grid , fid , &
362 ids, ide, jds, jde, kds, kde, &
363 ims, ime, jms, jme, kms, kme, &
364 its, ite, jts, jte, kts, kte )
365
366 USE module_io_wrf
367 USE module_domain
368 USE module_configure
369 USE module_io_domain
370
371 IMPLICIT NONE
372
373 TYPE ( domain ) :: grid
374 INTEGER , INTENT(IN) :: fid
375
376 INTEGER :: ids, ide, jds, jde, kds, kde, &
377 ims, ime, jms, jme, kms, kme, &
378 its, ite, jts, jte, kts, kte
379
380 INTEGER :: itmp , icnt , ierr
381
382 flag_psfc = 0
383 flag_soilhgt = 0
384 flag_toposoil = 0
385
386 flag_name(1:8) = 'TOPOSOIL'
387 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
388 IF ( ierr .EQ. 0 ) THEN
389 flag_toposoil = itmp
390 END IF
391
392 flag_name(1:8) = 'PSFC '
393 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
394 IF ( ierr .EQ. 0 ) THEN
395 flag_psfc = itmp
396 END IF
397
398 flag_name(1:8) = 'SOILHGT '
399 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
400 IF ( ierr .EQ. 0 ) THEN
401 flag_soilhgt = itmp
402 END IF
403
404 END SUBROUTINE optional_lsm
405
406 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
407
408 SUBROUTINE optional_lsm_levels ( grid , fid , &
409 ids, ide, jds, jde, kds, kde, &
410 ims, ime, jms, jme, kms, kme, &
411 its, ite, jts, jte, kts, kte )
412
413 USE module_io_wrf
414 USE module_domain
415 USE module_configure
416 USE module_io_domain
417
418 IMPLICIT NONE
419
420 TYPE ( domain ) :: grid
421 INTEGER , INTENT(IN) :: fid
422
423 INTEGER :: ids, ide, jds, jde, kds, kde, &
424 ims, ime, jms, jme, kms, kme, &
425 its, ite, jts, jte, kts, kte
426
427 INTEGER :: itmp , icnt , ierr , i , j
428
429 ! Initialize the soil temp and moisture flags to "field not found".
430
431 flag_st000010 = 0
432 flag_st010040 = 0
433 flag_st040100 = 0
434 flag_st100200 = 0
435 flag_st010200 = 0
436
437 flag_sm000010 = 0
438 flag_sm010040 = 0
439 flag_sm040100 = 0
440 flag_sm100200 = 0
441 flag_sm010200 = 0
442
443 flag_sw000010 = 0
444 flag_sw010040 = 0
445 flag_sw040100 = 0
446 flag_sw100200 = 0
447 flag_sw010200 = 0
448
449 flag_st000007 = 0
450 flag_st007028 = 0
451 flag_st028100 = 0
452 flag_st100255 = 0
453
454 flag_sm000007 = 0
455 flag_sm007028 = 0
456 flag_sm028100 = 0
457 flag_sm100255 = 0
458
459 flag_soilt000 = 0
460 flag_soilt005 = 0
461 flag_soilt020 = 0
462 flag_soilt040 = 0
463 flag_soilt160 = 0
464 flag_soilt300 = 0
465
466 flag_soilm000 = 0
467 flag_soilm005 = 0
468 flag_soilm020 = 0
469 flag_soilm040 = 0
470 flag_soilm160 = 0
471 flag_soilm300 = 0
472
473 flag_soilw000 = 0
474 flag_soilw005 = 0
475 flag_soilw020 = 0
476 flag_soilw040 = 0
477 flag_soilw160 = 0
478 flag_soilw300 = 0
479
480 ! How many soil levels have we found? Well, right now, none.
481
482 num_st_levels_input = 0
483 num_sm_levels_input = 0
484 num_sw_levels_input = 0
485 st_levels_input = -1
486 sm_levels_input = -1
487 sw_levels_input = -1
488
489 flag_name(1:8) = 'ST000010'
490 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
491 IF ( ierr .EQ. 0 ) THEN
492 flag_st000010 = itmp
493 num_st_levels_input = num_st_levels_input + 1
494 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
495 DO j = jts , MIN(jde-1,jte)
496 DO i = its , MIN(ide-1,ite)
497 st_input(i,num_st_levels_input + 1,j) = grid%st000010(i,j)
498 END DO
499 END DO
500 END IF
501 flag_name(1:8) = 'ST010040'
502 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
503 IF ( ierr .EQ. 0 ) THEN
504 flag_st010040 = itmp
505 num_st_levels_input = num_st_levels_input + 1
506 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
507 DO j = jts , MIN(jde-1,jte)
508 DO i = its , MIN(ide-1,ite)
509 st_input(i,num_st_levels_input + 1,j) = grid%st010040(i,j)
510 END DO
511 END DO
512 END IF
513 flag_name(1:8) = 'ST040100'
514 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
515 IF ( ierr .EQ. 0 ) THEN
516 flag_st040100 = itmp
517 num_st_levels_input = num_st_levels_input + 1
518 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
519 DO j = jts , MIN(jde-1,jte)
520 DO i = its , MIN(ide-1,ite)
521 st_input(i,num_st_levels_input + 1,j) = grid%st040100(i,j)
522 END DO
523 END DO
524 END IF
525 flag_name(1:8) = 'ST100200'
526 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
527 IF ( ierr .EQ. 0 ) THEN
528 flag_st100200 = itmp
529 num_st_levels_input = num_st_levels_input + 1
530 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
531 DO j = jts , MIN(jde-1,jte)
532 DO i = its , MIN(ide-1,ite)
533 st_input(i,num_st_levels_input + 1,j) = grid%st100200(i,j)
534 END DO
535 END DO
536 END IF
537 flag_name(1:8) = 'ST010200'
538 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
539 IF ( ierr .EQ. 0 ) THEN
540 flag_st010200 = itmp
541 num_st_levels_input = num_st_levels_input + 1
542 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
543 DO j = jts , MIN(jde-1,jte)
544 DO i = its , MIN(ide-1,ite)
545 st_input(i,num_st_levels_input + 1,j) = grid%st010200(i,j)
546 END DO
547 END DO
548 END IF
549 flag_name(1:8) = 'SM000010'
550 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
551 IF ( ierr .EQ. 0 ) THEN
552 flag_sm000010 = itmp
553 num_sm_levels_input = num_sm_levels_input + 1
554 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
555 DO j = jts , MIN(jde-1,jte)
556 DO i = its , MIN(ide-1,ite)
557 sm_input(i,num_sm_levels_input + 1,j) = grid%sm000010(i,j)
558 END DO
559 END DO
560 END IF
561 flag_name(1:8) = 'SM010040'
562 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
563 IF ( ierr .EQ. 0 ) THEN
564 flag_sm010040 = itmp
565 num_sm_levels_input = num_sm_levels_input + 1
566 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
567 DO j = jts , MIN(jde-1,jte)
568 DO i = its , MIN(ide-1,ite)
569 sm_input(i,num_sm_levels_input + 1,j) = grid%sm010040(i,j)
570 END DO
571 END DO
572 END IF
573 flag_name(1:8) = 'SM040100'
574 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
575 IF ( ierr .EQ. 0 ) THEN
576 flag_sm040100 = itmp
577 num_sm_levels_input = num_sm_levels_input + 1
578 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
579 DO j = jts , MIN(jde-1,jte)
580 DO i = its , MIN(ide-1,ite)
581 sm_input(i,num_sm_levels_input + 1,j) = grid%sm040100(i,j)
582 END DO
583 END DO
584 END IF
585 flag_name(1:8) = 'SM100200'
586 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
587 IF ( ierr .EQ. 0 ) THEN
588 flag_sm100200 = itmp
589 num_sm_levels_input = num_sm_levels_input + 1
590 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
591 DO j = jts , MIN(jde-1,jte)
592 DO i = its , MIN(ide-1,ite)
593 sm_input(i,num_sm_levels_input + 1,j) = grid%sm100200(i,j)
594 END DO
595 END DO
596 END IF
597 flag_name(1:8) = 'SM010200'
598 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
599 IF ( ierr .EQ. 0 ) THEN
600 flag_sm010200 = itmp
601 num_sm_levels_input = num_sm_levels_input + 1
602 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
603 DO j = jts , MIN(jde-1,jte)
604 DO i = its , MIN(ide-1,ite)
605 sm_input(i,num_sm_levels_input + 1,j) = grid%sm010200(i,j)
606 END DO
607 END DO
608 END IF
609 flag_name(1:8) = 'SW000010'
610 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
611 IF ( ierr .EQ. 0 ) THEN
612 flag_sw000010 = itmp
613 num_sw_levels_input = num_sw_levels_input + 1
614 sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
615 DO j = jts , MIN(jde-1,jte)
616 DO i = its , MIN(ide-1,ite)
617 sw_input(i,num_sw_levels_input + 1,j) = grid%sw000010(i,j)
618 END DO
619 END DO
620 END IF
621 flag_name(1:8) = 'SW010040'
622 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
623 IF ( ierr .EQ. 0 ) THEN
624 flag_sw010040 = itmp
625 num_sw_levels_input = num_sw_levels_input + 1
626 sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
627 DO j = jts , MIN(jde-1,jte)
628 DO i = its , MIN(ide-1,ite)
629 sw_input(i,num_sw_levels_input + 1,j) = grid%sw010040(i,j)
630 END DO
631 END DO
632 END IF
633 flag_name(1:8) = 'SW040100'
634 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
635 IF ( ierr .EQ. 0 ) THEN
636 flag_sw040100 = itmp
637 num_sw_levels_input = num_sw_levels_input + 1
638 sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
639 DO j = jts , MIN(jde-1,jte)
640 DO i = its , MIN(ide-1,ite)
641 sw_input(i,num_sw_levels_input + 1,j) = grid%sw040100(i,j)
642 END DO
643 END DO
644 END IF
645 flag_name(1:8) = 'SW100200'
646 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
647 IF ( ierr .EQ. 0 ) THEN
648 flag_sw100200 = itmp
649 num_sw_levels_input = num_sw_levels_input + 1
650 sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
651 DO j = jts , MIN(jde-1,jte)
652 DO i = its , MIN(ide-1,ite)
653 sw_input(i,num_sw_levels_input + 1,j) = grid%sw100200(i,j)
654 END DO
655 END DO
656 END IF
657 flag_name(1:8) = 'SW010200'
658 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
659 IF ( ierr .EQ. 0 ) THEN
660 flag_sw010200 = itmp
661 num_sw_levels_input = num_sw_levels_input + 1
662 sw_levels_input(num_sw_levels_input) = char2int2(flag_name(3:8))
663 DO j = jts , MIN(jde-1,jte)
664 DO i = its , MIN(ide-1,ite)
665 sw_input(i,num_sw_levels_input + 1,j) = grid%sw010200(i,j)
666 END DO
667 END DO
668 END IF
669 flag_name(1:8) = 'ST000007'
670 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
671 IF ( ierr .EQ. 0 ) THEN
672 flag_st000007 = itmp
673 num_st_levels_input = num_st_levels_input + 1
674 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
675 DO j = jts , MIN(jde-1,jte)
676 DO i = its , MIN(ide-1,ite)
677 st_input(i,num_st_levels_input + 1,j) = grid%st000007(i,j)
678 END DO
679 END DO
680 END IF
681 flag_name(1:8) = 'ST007028'
682 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
683 IF ( ierr .EQ. 0 ) THEN
684 flag_st007028 = itmp
685 num_st_levels_input = num_st_levels_input + 1
686 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
687 DO j = jts , MIN(jde-1,jte)
688 DO i = its , MIN(ide-1,ite)
689 st_input(i,num_st_levels_input + 1,j) = grid%st007028(i,j)
690 END DO
691 END DO
692 END IF
693 flag_name(1:8) = 'ST028100'
694 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
695 IF ( ierr .EQ. 0 ) THEN
696 flag_st028100 = itmp
697 num_st_levels_input = num_st_levels_input + 1
698 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
699 DO j = jts , MIN(jde-1,jte)
700 DO i = its , MIN(ide-1,ite)
701 st_input(i,num_st_levels_input + 1,j) = grid%st028100(i,j)
702 END DO
703 END DO
704 END IF
705 flag_name(1:8) = 'ST100255'
706 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
707 IF ( ierr .EQ. 0 ) THEN
708 flag_st100255 = itmp
709 num_st_levels_input = num_st_levels_input + 1
710 st_levels_input(num_st_levels_input) = char2int2(flag_name(3:8))
711 DO j = jts , MIN(jde-1,jte)
712 DO i = its , MIN(ide-1,ite)
713 st_input(i,num_st_levels_input + 1,j) = grid%st100255(i,j)
714 END DO
715 END DO
716 END IF
717 flag_name(1:8) = 'SM000007'
718 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
719 IF ( ierr .EQ. 0 ) THEN
720 flag_sm000007 = itmp
721 num_sm_levels_input = num_sm_levels_input + 1
722 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
723 DO j = jts , MIN(jde-1,jte)
724 DO i = its , MIN(ide-1,ite)
725 sm_input(i,num_sm_levels_input + 1,j) = grid%sm000007(i,j)
726 END DO
727 END DO
728 END IF
729 flag_name(1:8) = 'SM007028'
730 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
731 IF ( ierr .EQ. 0 ) THEN
732 flag_sm007028 = itmp
733 num_sm_levels_input = num_sm_levels_input + 1
734 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
735 DO j = jts , MIN(jde-1,jte)
736 DO i = its , MIN(ide-1,ite)
737 sm_input(i,num_sm_levels_input + 1,j) = grid%sm007028(i,j)
738 END DO
739 END DO
740 END IF
741 flag_name(1:8) = 'SM028100'
742 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
743 IF ( ierr .EQ. 0 ) THEN
744 flag_sm028100 = itmp
745 num_sm_levels_input = num_sm_levels_input + 1
746 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
747 DO j = jts , MIN(jde-1,jte)
748 DO i = its , MIN(ide-1,ite)
749 sm_input(i,num_sm_levels_input + 1,j) = grid%sm028100(i,j)
750 END DO
751 END DO
752 END IF
753 flag_name(1:8) = 'SM100255'
754 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
755 IF ( ierr .EQ. 0 ) THEN
756 flag_sm100255 = itmp
757 num_sm_levels_input = num_sm_levels_input + 1
758 sm_levels_input(num_sm_levels_input) = char2int2(flag_name(3:8))
759 DO j = jts , MIN(jde-1,jte)
760 DO i = its , MIN(ide-1,ite)
761 sm_input(i,num_sm_levels_input + 1,j) = grid%sm100255(i,j)
762 END DO
763 END DO
764 END IF
765 flag_name(1:8) = 'SOILT000'
766 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
767 IF ( ierr .EQ. 0 ) THEN
768 flag_soilt000 = itmp
769 num_st_levels_input = num_st_levels_input + 1
770 st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
771 DO j = jts , MIN(jde-1,jte)
772 DO i = its , MIN(ide-1,ite)
773 st_input(i,num_st_levels_input ,j) = grid%soilt000(i,j)
774 END DO
775 END DO
776 END IF
777 flag_name(1:8) = 'SOILT005'
778 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
779 IF ( ierr .EQ. 0 ) THEN
780 flag_soilt005 = itmp
781 num_st_levels_input = num_st_levels_input + 1
782 st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
783 DO j = jts , MIN(jde-1,jte)
784 DO i = its , MIN(ide-1,ite)
785 st_input(i,num_st_levels_input ,j) = grid%soilt005(i,j)
786 END DO
787 END DO
788 END IF
789 flag_name(1:8) = 'SOILT020'
790 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
791 IF ( ierr .EQ. 0 ) THEN
792 flag_soilt020 = itmp
793 num_st_levels_input = num_st_levels_input + 1
794 st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
795 DO j = jts , MIN(jde-1,jte)
796 DO i = its , MIN(ide-1,ite)
797 st_input(i,num_st_levels_input ,j) = grid%soilt020(i,j)
798 END DO
799 END DO
800 END IF
801 flag_name(1:8) = 'SOILT040'
802 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
803 IF ( ierr .EQ. 0 ) THEN
804 flag_soilt040 = itmp
805 num_st_levels_input = num_st_levels_input + 1
806 st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
807 DO j = jts , MIN(jde-1,jte)
808 DO i = its , MIN(ide-1,ite)
809 st_input(i,num_st_levels_input ,j) = grid%soilt040(i,j)
810 END DO
811 END DO
812 END IF
813 flag_name(1:8) = 'SOILT160'
814 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
815 IF ( ierr .EQ. 0 ) THEN
816 flag_soilt160 = itmp
817 num_st_levels_input = num_st_levels_input + 1
818 st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
819 DO j = jts , MIN(jde-1,jte)
820 DO i = its , MIN(ide-1,ite)
821 st_input(i,num_st_levels_input ,j) = grid%soilt160(i,j)
822 END DO
823 END DO
824 END IF
825 flag_name(1:8) = 'SOILT300'
826 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
827 IF ( ierr .EQ. 0 ) THEN
828 flag_soilt300 = itmp
829 num_st_levels_input = num_st_levels_input + 1
830 st_levels_input(num_st_levels_input) = char2int1(flag_name(6:8))
831 DO j = jts , MIN(jde-1,jte)
832 DO i = its , MIN(ide-1,ite)
833 st_input(i,num_st_levels_input ,j) = grid%soilt300(i,j)
834 END DO
835 END DO
836 END IF
837 flag_name(1:8) = 'SOILM000'
838 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
839 IF ( ierr .EQ. 0 ) THEN
840 flag_soilm000 = itmp
841 num_sm_levels_input = num_sm_levels_input + 1
842 sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
843 DO j = jts , MIN(jde-1,jte)
844 DO i = its , MIN(ide-1,ite)
845 sm_input(i,num_sm_levels_input ,j) = grid%soilm000(i,j)
846 END DO
847 END DO
848 END IF
849 flag_name(1:8) = 'SOILM005'
850 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
851 IF ( ierr .EQ. 0 ) THEN
852 flag_soilm005 = itmp
853 num_sm_levels_input = num_sm_levels_input + 1
854 sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
855 DO j = jts , MIN(jde-1,jte)
856 DO i = its , MIN(ide-1,ite)
857 sm_input(i,num_sm_levels_input ,j) = grid%soilm005(i,j)
858 END DO
859 END DO
860 END IF
861 flag_name(1:8) = 'SOILM020'
862 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
863 IF ( ierr .EQ. 0 ) THEN
864 flag_soilm020 = itmp
865 num_sm_levels_input = num_sm_levels_input + 1
866 sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
867 DO j = jts , MIN(jde-1,jte)
868 DO i = its , MIN(ide-1,ite)
869 sm_input(i,num_sm_levels_input ,j) = grid%soilm020(i,j)
870 END DO
871 END DO
872 END IF
873 flag_name(1:8) = 'SOILM040'
874 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
875 IF ( ierr .EQ. 0 ) THEN
876 flag_soilm040 = itmp
877 num_sm_levels_input = num_sm_levels_input + 1
878 sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
879 DO j = jts , MIN(jde-1,jte)
880 DO i = its , MIN(ide-1,ite)
881 sm_input(i,num_sm_levels_input ,j) = grid%soilm040(i,j)
882 END DO
883 END DO
884 END IF
885 flag_name(1:8) = 'SOILM160'
886 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
887 IF ( ierr .EQ. 0 ) THEN
888 flag_soilm160 = itmp
889 num_sm_levels_input = num_sm_levels_input + 1
890 sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
891 DO j = jts , MIN(jde-1,jte)
892 DO i = its , MIN(ide-1,ite)
893 sm_input(i,num_sm_levels_input ,j) = grid%soilm160(i,j)
894 END DO
895 END DO
896 END IF
897 flag_name(1:8) = 'SOILM300'
898 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
899 IF ( ierr .EQ. 0 ) THEN
900 flag_soilm300 = itmp
901 num_sm_levels_input = num_sm_levels_input + 1
902 sm_levels_input(num_sm_levels_input) = char2int1(flag_name(6:8))
903 DO j = jts , MIN(jde-1,jte)
904 DO i = its , MIN(ide-1,ite)
905 sm_input(i,num_sm_levels_input ,j) = grid%soilm300(i,j)
906 END DO
907 END DO
908 END IF
909 flag_name(1:8) = 'SOILW000'
910 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
911 IF ( ierr .EQ. 0 ) THEN
912 flag_soilw000 = itmp
913 num_sw_levels_input = num_sw_levels_input + 1
914 sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
915 DO j = jts , MIN(jde-1,jte)
916 DO i = its , MIN(ide-1,ite)
917 sw_input(i,num_sw_levels_input ,j) = grid%soilw000(i,j)
918 END DO
919 END DO
920 END IF
921 flag_name(1:8) = 'SOILW005'
922 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
923 IF ( ierr .EQ. 0 ) THEN
924 flag_soilw005 = itmp
925 num_sw_levels_input = num_sw_levels_input + 1
926 sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
927 DO j = jts , MIN(jde-1,jte)
928 DO i = its , MIN(ide-1,ite)
929 sw_input(i,num_sw_levels_input ,j) = grid%soilw005(i,j)
930 END DO
931 END DO
932 END IF
933 flag_name(1:8) = 'SOILW020'
934 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
935 IF ( ierr .EQ. 0 ) THEN
936 flag_soilw020 = itmp
937 num_sw_levels_input = num_sw_levels_input + 1
938 sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
939 DO j = jts , MIN(jde-1,jte)
940 DO i = its , MIN(ide-1,ite)
941 sw_input(i,num_sw_levels_input ,j) = grid%soilw020(i,j)
942 END DO
943 END DO
944 END IF
945 flag_name(1:8) = 'SOILW040'
946 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
947 IF ( ierr .EQ. 0 ) THEN
948 flag_soilw040 = itmp
949 num_sw_levels_input = num_sw_levels_input + 1
950 sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
951 DO j = jts , MIN(jde-1,jte)
952 DO i = its , MIN(ide-1,ite)
953 sw_input(i,num_sw_levels_input ,j) = grid%soilw040(i,j)
954 END DO
955 END DO
956 END IF
957 flag_name(1:8) = 'SOILW160'
958 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
959 IF ( ierr .EQ. 0 ) THEN
960 flag_soilw160 = itmp
961 num_sw_levels_input = num_sw_levels_input + 1
962 sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
963 DO j = jts , MIN(jde-1,jte)
964 DO i = its , MIN(ide-1,ite)
965 sw_input(i,num_sw_levels_input ,j) = grid%soilw160(i,j)
966 END DO
967 END DO
968 END IF
969 flag_name(1:8) = 'SOILW300'
970 CALL wrf_get_dom_ti_integer ( fid, 'FLAG_' // flag_name, itmp, 1, icnt, ierr )
971 IF ( ierr .EQ. 0 ) THEN
972 flag_soilw300 = itmp
973 num_sw_levels_input = num_sw_levels_input + 1
974 sw_levels_input(num_sw_levels_input) = char2int1(flag_name(6:8))
975 DO j = jts , MIN(jde-1,jte)
976 DO i = its , MIN(ide-1,ite)
977 sw_input(i,num_sw_levels_input ,j) = grid%soilw300(i,j)
978 END DO
979 END DO
980 END IF
981
982 ! OK, let's do a quick sanity check.
983
984 IF ( ( num_st_levels_input .GT. num_st_levels_alloc ) .OR. &
985 ( num_sm_levels_input .GT. num_sm_levels_alloc ) .OR. &
986 ( num_sw_levels_input .GT. num_sw_levels_alloc ) ) THEN
987 print *,'pain and woe, the soil level allocation is too small'
988 CALL wrf_error_fatal ( 'soil_levels_too_few' )
989 END IF
990
991 END SUBROUTINE optional_lsm_levels
992
993 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
994
995 FUNCTION char2int1( string3 ) RESULT ( int1 )
996 CHARACTER (LEN=3) , INTENT(IN) :: string3
997 INTEGER :: i1 , int1
998 READ(string3,fmt='(I3)') i1
999 int1 = i1
1000 END FUNCTION char2int1
1001
1002 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1003
1004 FUNCTION char2int2( string6 ) RESULT ( int1 )
1005 CHARACTER (LEN=6) , INTENT(IN) :: string6
1006 INTEGER :: i2 , i1 , int1
1007 READ(string6,fmt='(I3,I3)') i1,i2
1008 int1 = ( i2 + i1 ) / 2
1009 END FUNCTION char2int2
1010
1011 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1012
1013 END MODULE module_optional_si_input