Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_optional_input.F @ 3567

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

Rev	Line
[2759]	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