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