Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_optional_input.F @ 3549

Last change on this file since 3549 was 2759, checked in by aslmd, 3 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 38.9 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format