Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_si_io_nmm.F @ 3709

Last change on this file since 3709 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: 50.7 KB

Line
1	MODULE module_si_io_nmm
2
3	USE module_optional_input
4
5	IMPLICIT NONE
6
7	! Input 3D meteorological fields.
8
9	REAL , DIMENSION(:,:,:) , ALLOCATABLE :: u_input , v_input , &
10	q_input , t_input
11
12	! Input 3D LSM fields.
13
14	REAL , DIMENSION(:,:,:) , ALLOCATABLE :: landuse_frac_input , &
15	soil_top_cat_input , &
16	soil_bot_cat_input
17
18	REAL, ALLOCATABLE:: htm_in(:,:,:),vtm_in(:,:,:)
19
20	! Input 2D surface fields.
21
22	REAL , DIMENSION(:,:) , ALLOCATABLE :: soilt010_input , soilt040_input , &
23	soilt100_input , soilt200_input , &
24	soilm010_input , soilm040_input , &
25	soilm100_input , soilm200_input , &
26	psfc_in,pmsl
27
28	REAL , DIMENSION(:,:) , ALLOCATABLE :: lat_wind, lon_wind
29
30	REAL , DIMENSION(:) , ALLOCATABLE :: DETA_in, AETA_in, ETAX_in
31	REAL , DIMENSION(:) , ALLOCATABLE :: DETA1_in, AETA1_in, ETA1_in
32	REAL , DIMENSION(:) , ALLOCATABLE :: DETA2_in, AETA2_in, ETA2_in, DFL_in
33
34	REAL , DIMENSION(:,:,:), ALLOCATABLE :: st_inputx , sm_inputx, sw_inputx
35
36	! Local input arrays
37
38	REAL,DIMENSION(:,:),ALLOCATABLE :: dum2d
39	INTEGER,DIMENSION(:,:),ALLOCATABLE :: idum2d
40	REAL,DIMENSION(:,:,:),ALLOCATABLE :: dum3d
41
42	LOGICAL , SAVE :: first_time_in = .TRUE.
43
44	INTEGER :: flag_soilt010 , flag_soilt100 , flag_soilt200 , &
45	flag_soilm010 , flag_soilm100 , flag_soilm200
46
47	! Some constants to allow simple dimensions in the defined types
48	! given below.
49
50	INTEGER, PARAMETER :: var_maxdims = 5
51	INTEGER, PARAMETER :: max_staggers_xy_new = 4
52	INTEGER, PARAMETER :: max_staggers_xy_old = 3
53	INTEGER, PARAMETER :: max_staggers_z = 2
54	INTEGER, PARAMETER :: max_standard_lats = 4
55	INTEGER, PARAMETER :: max_standard_lons = 4
56	INTEGER, PARAMETER :: max_fg_variables = 200
57	INTEGER, PARAMETER :: max_vertical_levels = 2000
58
59	! This module defines the items needed for the WRF metadata
60	! which is broken up into three levels:
61	! Global metadata: Those things which apply to the
62	! entire simulation that are
63	! independent of time, domain, or
64	! variable
65	!
66	! Domain metadata: Those things which apply to
67	! a single domain (this may
68	! or may not be time dependent)
69	!
70	! Variable metadata: Those things which apply to
71	! a specific variable at a
72	! specific time
73	!
74	! The variable names and definitions can be
75	! found in the wrf_metadata spec, which is still
76	! a living document as coding goes on. The names
77	! may not match exactly, but you should be able
78	! to figure things out.
79	!
80
81	TYPE wrf_var_metadata
82	CHARACTER (LEN=8) :: name
83	CHARACTER (LEN=16) :: units
84	CHARACTER (LEN=80) :: description
85	INTEGER :: domain_id
86	INTEGER :: ndim
87	INTEGER :: dim_val (var_maxdims)
88	CHARACTER(LEN=4) :: dim_desc (var_maxdims)
89	INTEGER :: start_index(var_maxdims)
90	INTEGER :: stop_index(var_maxdims)
91	INTEGER :: h_stagger_index
92	INTEGER :: v_stagger_index
93	CHARACTER(LEN=8) :: array_order
94	CHARACTER(LEN=4) :: field_type
95	CHARACTER(LEN=8) :: field_source_prog
96	CHARACTER(LEN=80) :: source_desc
97	CHARACTER(LEN=8) :: field_time_type
98	INTEGER :: vt_date_start
99	REAL :: vt_time_start
100	INTEGER :: vt_date_stop
101	REAL :: vt_time_stop
102	END TYPE wrf_var_metadata
103
104	TYPE(wrf_var_metadata) :: var_meta , var_info
105
106	TYPE wrf_domain_metadata
107	INTEGER :: id
108	INTEGER :: parent_id
109	CHARACTER(LEN=8) :: dyn_init_src
110	CHARACTER(LEN=8) :: static_init_src
111	INTEGER :: vt_date
112	REAL :: vt_time
113	INTEGER :: origin_parent_x
114	INTEGER :: origin_parent_y
115	INTEGER :: ratio_to_parent
116	REAL :: delta_x
117	REAL :: delta_y
118	REAL :: top_level
119	INTEGER :: origin_parent_z
120	REAL :: corner_lats_new(4,max_staggers_xy_new)
121	REAL :: corner_lons_new(4,max_staggers_xy_new)
122	REAL :: corner_lats_old(4,max_staggers_xy_old)
123	REAL :: corner_lons_old(4,max_staggers_xy_old)
124	INTEGER :: xdim
125	INTEGER :: ydim
126	INTEGER :: zdim
127	END TYPE wrf_domain_metadata
128	TYPE(wrf_domain_metadata) :: dom_meta
129
130	TYPE wrf_global_metadata
131	CHARACTER(LEN=80) :: simulation_name
132	CHARACTER(LEN=80) :: user_desc
133	INTEGER :: si_version
134	INTEGER :: analysis_version
135	INTEGER :: wrf_version
136	INTEGER :: post_version
137	CHARACTER(LEN=32) :: map_projection
138	REAL :: moad_known_lat
139	REAL :: moad_known_lon
140	CHARACTER(LEN=8) :: moad_known_loc
141	REAL :: moad_stand_lats(max_standard_lats)
142	REAL :: moad_stand_lons(max_standard_lons)
143	REAL :: moad_delta_x
144	REAL :: moad_delta_y
145	CHARACTER(LEN=4) :: horiz_stagger_type
146	INTEGER :: num_stagger_xy
147	REAL :: stagger_dir_x_new(max_staggers_xy_new)
148	REAL :: stagger_dir_y_new(max_staggers_xy_new)
149	REAL :: stagger_dir_x_old(max_staggers_xy_old)
150	REAL :: stagger_dir_y_old(max_staggers_xy_old)
151	INTEGER :: num_stagger_z
152	REAL :: stagger_dir_z(max_staggers_z)
153	CHARACTER(LEN=8) :: vertical_coord
154	INTEGER :: num_domains
155	INTEGER :: init_date
156	REAL :: init_time
157	INTEGER :: end_date
158	REAL :: end_time
159	CHARACTER(LEN=4) :: lu_source
160	INTEGER :: lu_water
161	INTEGER :: lu_ice
162	END TYPE wrf_global_metadata
163	TYPE(wrf_global_metadata) :: global_meta
164
165	CONTAINS
166
167	SUBROUTINE read_si ( grid, file_date_string )
168
169	USE module_soil_pre
170	USE module_domain
171
172	IMPLICIT NONE
173
174	TYPE(domain) , INTENT(INOUT) :: grid
175	CHARACTER (LEN=19) , INTENT(IN) :: file_date_string
176
177	INTEGER :: ids,ide,jds,jde,kds,kde &
178	,ims,ime,jms,jme,kms,kme &
179	,its,ite,jts,jte,kts,kte
180
181	INTEGER :: i , j , k , loop, IMAX, JMAX
182
183	REAL :: dummy
184
185	CHARACTER (LEN= 8) :: dummy_char
186
187	INTEGER :: ok , map_proj , ok_open
188	REAL :: pt
189	INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
190
191	SELECT CASE ( model_data_order )
192	CASE ( DATA_ORDER_ZXY )
193	kds = grid%sd31 ; kde = grid%ed31 ;
194	ids = grid%sd32 ; ide = grid%ed32 ;
195	jds = grid%sd33 ; jde = grid%ed33 ;
196
197	kms = grid%sm31 ; kme = grid%em31 ;
198	ims = grid%sm32 ; ime = grid%em32 ;
199	jms = grid%sm33 ; jme = grid%em33 ;
200
201	kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
202	its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
203	jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
204
205	CASE ( DATA_ORDER_XYZ )
206	ids = grid%sd31 ; ide = grid%ed31 ;
207	jds = grid%sd32 ; jde = grid%ed32 ;
208	kds = grid%sd33 ; kde = grid%ed33 ;
209
210	ims = grid%sm31 ; ime = grid%em31 ;
211	jms = grid%sm32 ; jme = grid%em32 ;
212	kms = grid%sm33 ; kme = grid%em33 ;
213
214	its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
215	jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
216	kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
217
218	CASE ( DATA_ORDER_XZY )
219	ids = grid%sd31 ; ide = grid%ed31 ;
220	kds = grid%sd32 ; kde = grid%ed32 ;
221	jds = grid%sd33 ; jde = grid%ed33 ;
222
223	ims = grid%sm31 ; ime = grid%em31 ;
224	kms = grid%sm32 ; kme = grid%em32 ;
225	jms = grid%sm33 ; jme = grid%em33 ;
226
227	its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
228	kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
229	jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
230
231	END SELECT
232
233	! Initialize what soil temperature and moisture is available.
234
235	write(0,*) 'dum3d I allocs: ', ids,ide-1
236	write(0,*) 'dum3d J allocs: ', jds,jde-1
237	write(0,*) 'dum3d K allocs: ', kds,kde-1
238
239	flag_st000010 = 0
240	flag_st010040 = 0
241	flag_st040100 = 0
242	flag_st100200 = 0
243	flag_sm000010 = 0
244	flag_sm010040 = 0
245	flag_sm040100 = 0
246	flag_sm100200 = 0
247	flag_st010200 = 0
248	flag_sm010200 = 0
249
250	flag_soilt010 = 0
251	flag_soilt040 = 0
252	flag_soilt100 = 0
253	flag_soilt200 = 0
254	flag_soilm010 = 0
255	flag_soilm040 = 0
256	flag_soilm100 = 0
257	flag_soilm200 = 0
258
259	flag_sst = 0
260	flag_toposoil = 0
261
262	! How many soil levels have we found? Well, right now, none.
263
264	num_st_levels_input = 0
265	num_sm_levels_input = 0
266	st_levels_input = -1
267	sm_levels_input = -1
268
269	! Get the space for the data if this is the first time here.
270
271	write(6,*) 'enter read_si...first_time_in:: ', first_time_in
272
273	IF ( first_time_in ) THEN
274
275	CLOSE(12)
276	OPEN ( FILE = 'real_input_nm.global.metadata' , &
277	UNIT = 12 , &
278	STATUS = 'OLD' , &
279	ACCESS = 'SEQUENTIAL' , &
280	FORM = 'UNFORMATTED' , &
281	IOSTAT = ok_open )
282
283	IF ( ok_open .NE. 0 ) THEN
284	PRINT '(A)','You asked for WRF SI data, but no real_input_nm.global.metadata file exists.'
285	STOP 'No_real_input_nm.global.metadata_exists'
286	END IF
287
288	READ(12) global_meta%simulation_name, global_meta%user_desc, &
289	global_meta%si_version, global_meta%analysis_version, &
290	global_meta%wrf_version, global_meta%post_version
291
292	REWIND (12)
293
294	IF ( global_meta%si_version .EQ. 1 ) THEN
295	READ(12) global_meta%simulation_name, global_meta%user_desc, &
296	global_meta%si_version, global_meta%analysis_version, &
297	global_meta%wrf_version, global_meta%post_version, &
298	global_meta%map_projection, global_meta%moad_known_lat, &
299	global_meta%moad_known_lon, global_meta%moad_known_loc, &
300	global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
301	global_meta%moad_delta_x, global_meta%moad_delta_y, &
302	global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
303	global_meta%stagger_dir_x_old, global_meta%stagger_dir_y_old, &
304	global_meta%num_stagger_z, global_meta%stagger_dir_z, &
305	global_meta%vertical_coord, global_meta%num_domains, &
306	global_meta%init_date, global_meta%init_time, &
307	global_meta%end_date, global_meta%end_time
308	ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
309	READ(12) global_meta%simulation_name, global_meta%user_desc, &
310	global_meta%si_version, global_meta%analysis_version, &
311	global_meta%wrf_version, global_meta%post_version, &
312	global_meta%map_projection, global_meta%moad_known_lat, &
313	global_meta%moad_known_lon, global_meta%moad_known_loc, &
314	global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
315	global_meta%moad_delta_x, global_meta%moad_delta_y, &
316	global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
317	global_meta%stagger_dir_x_new, global_meta%stagger_dir_y_new, &
318	global_meta%num_stagger_z, global_meta%stagger_dir_z, &
319	global_meta%vertical_coord, global_meta%num_domains, &
320	global_meta%init_date, global_meta%init_time, &
321	global_meta%end_date, global_meta%end_time , &
322	global_meta%lu_source, global_meta%lu_water, global_meta%lu_ice
323	END IF
324	CLOSE (12)
325
326	print *,'GLOBAL METADATA'
327	print *,'global_meta%simulation_name', global_meta%simulation_name
328	print *,'global_meta%user_desc', global_meta%user_desc
329	print *,'global_meta%user_desc', global_meta%user_desc
330	print *,'global_meta%si_version', global_meta%si_version
331	print *,'global_meta%analysis_version', global_meta%analysis_version
332	print *,'global_meta%wrf_version', global_meta%wrf_version
333	print *,'global_meta%post_version', global_meta%post_version
334	print *,'global_meta%map_projection', global_meta%map_projection
335	print *,'global_meta%moad_known_lat', global_meta%moad_known_lat
336	print *,'global_meta%moad_known_lon', global_meta%moad_known_lon
337	print *,'global_meta%moad_known_loc', global_meta%moad_known_loc
338	print *,'global_meta%moad_stand_lats', global_meta%moad_stand_lats
339	print *,'global_meta%moad_stand_lons', global_meta%moad_stand_lons
340	print *,'global_meta%moad_delta_x', global_meta%moad_delta_x
341	print *,'global_meta%moad_delta_y', global_meta%moad_delta_y
342	print *,'global_meta%horiz_stagger_type', global_meta%horiz_stagger_type
343	print *,'global_meta%num_stagger_xy', global_meta%num_stagger_xy
344	IF ( global_meta%si_version .EQ. 1 ) THEN
345	print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_old
346	print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_old
347	ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
348	print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_new
349	print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_new
350	END IF
351	print *,'global_meta%num_stagger_z', global_meta%num_stagger_z
352	print *,'global_meta%stagger_dir_z', global_meta%stagger_dir_z
353	print *,'global_meta%vertical_coord', global_meta%vertical_coord
354	print *,'global_meta%num_domains', global_meta%num_domains
355	print *,'global_meta%init_date', global_meta%init_date
356	print *,'global_meta%init_time', global_meta%init_time
357	print *,'global_meta%end_date', global_meta%end_date
358	print *,'global_meta%end_time', global_meta%end_time
359	IF ( global_meta%si_version .EQ. 2 ) THEN
360	print *,'global_meta%lu_source', global_meta%lu_source
361	print *,'global_meta%lu_water', global_meta%lu_water
362	print *,'global_meta%lu_ice', global_meta%lu_ice
363	END IF
364	print *,' '
365
366	! 1D - this is the definition of the vertical coordinate.
367
368	IF (.NOT. ALLOCATED (DETA_in)) ALLOCATE(DETA_in(kds:kde-1))
369	IF (.NOT. ALLOCATED (AETA_in)) ALLOCATE(AETA_in(kds:kde-1))
370	IF (.NOT. ALLOCATED (ETAX_in)) ALLOCATE(ETAX_in(kds:kde))
371
372	IF (.NOT. ALLOCATED (DETA1_in)) ALLOCATE(DETA1_in(kds:kde-1))
373	IF (.NOT. ALLOCATED (AETA1_in)) ALLOCATE(AETA1_in(kds:kde-1))
374	IF (.NOT. ALLOCATED (ETA1_in)) ALLOCATE(ETA1_in(kds:kde))
375
376	IF (.NOT. ALLOCATED (DETA2_in)) ALLOCATE(DETA2_in(kds:kde-1))
377	IF (.NOT. ALLOCATED (AETA2_in)) ALLOCATE(AETA2_in(kds:kde-1))
378	IF (.NOT. ALLOCATED (ETA2_in)) ALLOCATE(ETA2_in(kds:kde))
379
380	IF (.NOT. ALLOCATED (DFL_in)) ALLOCATE(DFL_in(kds:kde))
381
382	! 3D met
383
384	IF (.NOT. ALLOCATED (u_input) ) ALLOCATE ( u_input(its:ite,jts:jte,kts:kte) )
385	IF (.NOT. ALLOCATED (v_input) ) ALLOCATE ( v_input(its:ite,jts:jte,kts:kte) )
386	IF (.NOT. ALLOCATED (q_input) ) ALLOCATE ( q_input(its:ite,jts:jte,kts:kte) )
387	IF (.NOT. ALLOCATED (t_input) ) ALLOCATE ( t_input(its:ite,jts:jte,kts:kte) )
388	IF (.NOT. ALLOCATED (htm_in) ) ALLOCATE ( htm_in(its:ite,jts:jte,kts:kte) )
389	IF (.NOT. ALLOCATED (vtm_in) ) ALLOCATE ( vtm_in(its:ite,jts:jte,kts:kte) )
390
391	! 2D pressure fields
392
393	IF (.NOT. ALLOCATED (pmsl) ) ALLOCATE ( pmsl(its:ite,jts:jte) )
394	IF (.NOT. ALLOCATED (psfc_in) ) ALLOCATE ( psfc_in(its:ite,jts:jte) )
395
396	! 2D - for LSM, these are computed from the categorical precentage values.
397
398	! 2D - for LSM, the various soil temperature and moisture levels that are available.
399
400	IF (.NOT. ALLOCATED (st_inputx)) ALLOCATE (st_inputx(its:ite,jts:jte,num_st_levels_alloc))
401	IF (.NOT. ALLOCATED (sm_inputx)) ALLOCATE (sm_inputx(its:ite,jts:jte,num_st_levels_alloc))
402	IF (.NOT. ALLOCATED (sw_inputx)) ALLOCATE (sw_inputx(its:ite,jts:jte,num_st_levels_alloc))
403
404	IF (.NOT. ALLOCATED (soilt010_input) ) ALLOCATE ( soilt010_input(its:ite,jts:jte) )
405	IF (.NOT. ALLOCATED (soilt040_input) ) ALLOCATE ( soilt040_input(its:ite,jts:jte) )
406	IF (.NOT. ALLOCATED (soilt100_input) ) ALLOCATE ( soilt100_input(its:ite,jts:jte) )
407	IF (.NOT. ALLOCATED (soilt200_input) ) ALLOCATE ( soilt200_input(its:ite,jts:jte) )
408	IF (.NOT. ALLOCATED (soilm010_input) ) ALLOCATE ( soilm010_input(its:ite,jts:jte) )
409	IF (.NOT. ALLOCATED (soilm040_input) ) ALLOCATE ( soilm040_input(its:ite,jts:jte) )
410	IF (.NOT. ALLOCATED (soilm100_input) ) ALLOCATE ( soilm100_input(its:ite,jts:jte) )
411	IF (.NOT. ALLOCATED (soilm200_input) ) ALLOCATE ( soilm200_input(its:ite,jts:jte) )
412
413	IF (.NOT. ALLOCATED (lat_wind) ) ALLOCATE (lat_wind(its:ite,jts:jte))
414	IF (.NOT. ALLOCATED (lon_wind) ) ALLOCATE (lon_wind(its:ite,jts:jte))
415
416	! Local arrays
417	IF (.NOT. ALLOCATED (dum2d) ) ALLOCATE (dum2d(IDS:IDE-1,JDS:JDE-1))
418	IF (.NOT. ALLOCATED (idum2d) ) ALLOCATE (idum2d(IDS:IDE-1,JDS:JDE-1))
419	IF (.NOT. ALLOCATED (dum3d) ) ALLOCATE (dum3d(IDS:IDE-1,JDS:JDE-1,KDS:KDE-1))
420
421
422	END IF
423
424	CLOSE(13)
425
426	write(6,*) 'file_date_string: ', file_date_string
427	write(6,*) 'opening real_input_nm.d01.'//file_date_string//' as unit 13'
428	OPEN ( FILE = 'real_input_nm.d01.'//file_date_string , &
429	UNIT = 13 , &
430	STATUS = 'OLD' , &
431	ACCESS = 'SEQUENTIAL' , &
432	FORM = 'UNFORMATTED' )
433
434	IF ( global_meta%si_version .EQ. 1 ) THEN
435	READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
436	dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
437	dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
438	dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
439	dom_meta%top_level, dom_meta%origin_parent_z, &
440	dom_meta%corner_lats_old, dom_meta%corner_lons_old, dom_meta%xdim, &
441	dom_meta%ydim, dom_meta%zdim
442	ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
443	READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
444	dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
445	dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
446	dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
447	dom_meta%top_level, dom_meta%origin_parent_z, &
448	dom_meta%corner_lats_new, dom_meta%corner_lons_new, dom_meta%xdim, &
449	dom_meta%ydim, dom_meta%zdim
450	END IF
451
452	print *,'DOMAIN METADATA'
453	print *,'dom_meta%id=', dom_meta%id
454	print *,'dom_meta%parent_id=', dom_meta%parent_id
455	print *,'dom_meta%dyn_init_src=', dom_meta%dyn_init_src
456	print *,'dom_meta%static_init_src=', dom_meta%static_init_src
457	print *,'dom_meta%vt_date=', dom_meta%vt_date
458	print *,'dom_meta%vt_time=', dom_meta%vt_time
459	print *,'dom_meta%origin_parent_x=', dom_meta%origin_parent_x
460	print *,'dom_meta%origin_parent_y=', dom_meta%origin_parent_y
461	print *,'dom_meta%ratio_to_parent=', dom_meta%ratio_to_parent
462	print *,'dom_meta%delta_x=', dom_meta%delta_x
463	print *,'dom_meta%delta_y=', dom_meta%delta_y
464	print *,'dom_meta%top_level=', dom_meta%top_level
465	print *,'dom_meta%origin_parent_z=', dom_meta%origin_parent_z
466	IF ( global_meta%si_version .EQ. 1 ) THEN
467	print *,'dom_meta%corner_lats=', dom_meta%corner_lats_old
468	print *,'dom_meta%corner_lons=', dom_meta%corner_lons_old
469	ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
470	print *,'dom_meta%corner_lats=', dom_meta%corner_lats_new
471	print *,'dom_meta%corner_lons=', dom_meta%corner_lons_new
472	END IF
473	print *,'dom_meta%xdim=', dom_meta%xdim
474	print *,'dom_meta%ydim=', dom_meta%ydim
475	print *,'dom_meta%zdim=', dom_meta%zdim
476	print *,' '
477
478	! A simple domain size test.
479
480
481	!! relax constraint, as model namelist has +1 for i and j, while
482	!! si data has true dimensions
483
484	IF ( abs(dom_meta%xdim - (ide-1)) .gt. 1 &
485	.OR. abs(dom_meta%ydim - (jde-1)) .gt. 1 &
486	.OR. abs(dom_meta%zdim - (kde-1)) .gt. 1) THEN
487	PRINT '(A)','Namelist does not match the input data.'
488	PRINT '(A,3I5,A)','Namelist dimensions =',ide-1,jde-1,kde-1,'.'
489	PRINT '(A,3I5,A)','Input data dimensions =',dom_meta%xdim,dom_meta%ydim,dom_meta%zdim,'.'
490	STOP 'Wrong_data_size'
491	END IF
492
493	! How about the grid distance? Is it the same as in the namelist?
494
495	IF ( global_meta%si_version .EQ. 1 ) THEN
496	CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_old(1,1) + dom_meta%corner_lats_old(2,1) + &
497	dom_meta%corner_lats_old(3,1) + dom_meta%corner_lats_old(4,1) ) * 0.25 )
498	ELSE IF ( ( global_meta%si_version .EQ. 2 ) .AND. ( global_meta%moad_known_loc(1:6) .EQ. 'CENTER' ) ) THEN
499	CALL nl_set_cen_lat ( grid%id , global_meta%moad_known_lat )
500	ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
501	CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_new(1,1) + dom_meta%corner_lats_new(2,1) + &
502	dom_meta%corner_lats_new(3,1) + dom_meta%corner_lats_new(4,1) ) * 0.25 )
503	END IF
504
505
506	!!! might be trouble here
507
508	CALL nl_set_cen_lon ( grid%id , global_meta%moad_stand_lons(1) )
509	!!!!!
510	write(6,*) 'set_cen_lat... global_meta%moad_stand_lats(1): ', global_meta%moad_stand_lats(1)
511	CALL nl_set_cen_lat ( grid%id , global_meta%moad_stand_lats(1) )
512	!!!!!
513	CALL nl_set_truelat1 ( grid%id , global_meta%moad_stand_lats(1) )
514	CALL nl_set_truelat2 ( grid%id , global_meta%moad_stand_lats(2) )
515
516	pt = dom_meta%top_level
517
518	IF ( global_meta%map_projection(1:17) .EQ. 'LAMBERT CONFORMAL' ) THEN
519	map_proj = 1
520	ELSE IF ( global_meta%map_projection(1:19) .EQ. 'POLAR STEREOGRAPHIC' ) THEN
521	map_proj = 2
522	ELSE IF ( global_meta%map_projection(1: 8) .EQ. 'MERCATOR' ) THEN
523	map_proj = 3
524	ELSE IF ( global_meta%map_projection(1:14) .EQ. 'ROTATED LATLON' ) THEN
525	map_proj = 203 !?
526	ELSE
527	PRINT '(A,A,A)','Undefined map projection: ',TRIM(global_meta%map_projection(1:20)),'.'
528	STOP 'Undefined_map_proj_si'
529	END IF
530	CALL nl_set_map_proj ( grid%id , map_proj )
531
532	write(0,*) 'global_meta%si_version: ', global_meta%si_version
533	write(0,*) 'global_meta%lu_source: ', global_meta%lu_source
534	write(0,*) 'global_meta%lu_water: ', global_meta%lu_water
535	IF ( global_meta%si_version .EQ. 1 ) THEN
536	CALL nl_set_mminlu (grid%id, 'USGS' )
537	CALL nl_set_iswater (grid%id, 16 )
538	ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
539	CALL nl_set_mminlu ( grid%id, global_meta%lu_source )
540	CALL nl_set_iswater (grid%id, global_meta%lu_water )
541	CALL nl_set_isice (grid%id, global_meta%lu_ice )
542	END IF
543
544	CALL nl_set_gmt (grid%id, dom_meta%vt_time / 3600. )
545	CALL nl_set_julyr (grid%id, dom_meta%vt_date / 1000 )
546	CALL nl_set_julday (grid%id, dom_meta%vt_date - ( dom_meta%vt_date / 1000 ) * 1000 )
547
548	write(6,*) 'start reading from unit 13'
549	read_all_the_data : DO
550
551	READ (13,IOSTAT=OK) var_info%name, var_info%units, &
552	var_info%description, var_info%domain_id, var_info%ndim, &
553	var_info%dim_val, var_info%dim_desc, var_info%start_index, &
554	var_info%stop_index, var_info%h_stagger_index, var_info%v_stagger_index,&
555	var_info%array_order, var_info%field_type, var_info%field_source_prog, &
556	var_info%source_desc, var_info%field_time_type, var_info%vt_date_start, &
557	var_info%vt_time_start, var_info%vt_date_stop, var_info%vt_time_stop
558
559	IF ( OK .NE. 0 ) THEN
560	PRINT '(A,A,A)','End of file found for real_input_nm.d01.',file_date_string,'.'
561	EXIT read_all_the_data
562	END IF
563
564	! print *,'VARIABLE METADATA'
565	PRINT '(A,A)','var_info%name=', var_info%name
566	! print *,'var_info%units=', var_info%units
567	! print *,'var_info%description=', var_info%description
568	! print *,'var_info%domain_id=', var_info%domain_id
569	! print *,'var_info%ndim=', var_info%ndim
570	! print *,'var_info%dim_val=', var_info%dim_val
571	! print *,'var_info%dim_desc=', var_info%dim_desc
572	! print *,'var_info%start_index=', var_info%start_index
573	! print *,'var_info%stop_index=', var_info%stop_index
574	! print *,'var_info%h_stagger_index=', var_info%h_stagger_index
575	! print *,'var_info%v_stagger_index=', var_info%v_stagger_index
576	! print *,'var_info%array_order=', var_info%array_order
577	! print *,'var_info%field_type=', var_info%field_type
578	! print *,'var_info%field_source_prog=', var_info%field_source_prog
579	! print *,'var_info%source_desc=', var_info%source_desc
580	! print *,'var_info%field_time_type=', var_info%field_time_type
581	! print *,'var_info%vt_date_start=', var_info%vt_date_start
582	! print *,'var_info%vt_time_start=', var_info%vt_time_start
583	! print *,'var_info%vt_date_stop=', var_info%vt_date_stop
584	! print *,'var_info%vt_time_stop=', var_info%vt_time_stop
585
586	JMAX=min(JDE-1,JTE)
587	IMAX=min(IDE-1,ITE)
588	! 3D meteorological fields.
589
590	write(0,*)' read_si var_info%name=',var_info%name(1:8)
591
592	IF ( var_info%name(1:8) .EQ. 'T ' ) THEN
593	READ (13) dum3d
594	do k=kts,kte-1
595	do j=jts,JMAX
596	do i=its,IMAX
597	t_input(i,j,k)=dum3d(i,j,k)
598	enddo
599	enddo
600	enddo
601
602	ELSE IF ( var_info%name(1:8) .EQ. 'U ' ) THEN
603	READ (13) dum3d
604	do k=kts,kte-1
605	do j=jts,JMAX
606	do i=its,IMAX
607	u_input(i,j,k)=dum3d(i,j,k)
608	enddo
609	enddo
610	enddo
611
612	ELSE IF ( var_info%name(1:8) .EQ. 'V ' ) THEN
613	READ (13) dum3d
614	do k=kts,kte-1
615	do j=jts,JMAX
616	do i=its,IMAX
617	v_input(i,j,k)=dum3d(i,j,k)
618	enddo
619	enddo
620	enddo
621
622	ELSE IF ( var_info%name(1:8) .EQ. 'Q ' ) THEN
623	READ (13) dum3d
624	do k=kts,kte-1
625	do j=jts,JMAX
626	do i=its,IMAX
627	q_input(i,j,k)=dum3d(i,j,k)
628	enddo
629	enddo
630	enddo
631
632	! 3D LSM fields. Don't know the 3rd dimension until we read it in.
633
634	ELSE IF ( var_info%name(1:8) .EQ. 'LANDUSEF' ) THEN
635	IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( landuse_frac_input) ) ) THEN
636	ALLOCATE (landuse_frac_input(its:ite,jts:jte,var_info%dim_val(3)) )
637	END IF
638	READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
639	do k=1,var_info%dim_val(3)
640	do j=jts,JMAX
641	do i=its,IMAX
642	landuse_frac_input(i,j,k)=dum3d(i,j,k)
643	enddo
644	enddo
645	enddo
646	ELSE IF ( var_info%name(1:8) .EQ. 'SOILCTOP' ) THEN
647	IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_top_cat_input) ) ) THEN
648	ALLOCATE (soil_top_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
649	END IF
650	READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
651	do k=1,var_info%dim_val(3)
652	do j=jts,JMAX
653	do i=its,IMAX
654	soil_top_cat_input(i,j,k)=dum3d(i,j,k)
655	enddo
656	enddo
657	enddo
658	ELSE IF ( var_info%name(1:8) .EQ. 'SOILCBOT' ) THEN
659	IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_bot_cat_input) ) ) THEN
660	ALLOCATE (soil_bot_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
661	END IF
662	READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
663	do k=1,var_info%dim_val(3)
664	do j=jts,JMAX
665	do i=its,IMAX
666	soil_bot_cat_input(i,j,k)=dum3d(i,j,k)
667	enddo
668	enddo
669	enddo
670
671	! 2D dry pressure minus ptop.
672
673	ELSE IF ( var_info%name(1:8) .EQ. 'PD ' ) THEN
674	READ (13) dum2d
675	do j=jts,JMAX
676	do i=its,IMAX
677	grid%pd(i,j)=dum2d(i,j)
678	enddo
679	enddo
680	ELSE IF ( var_info%name(1:8) .EQ. 'PSFC ' ) THEN
681	READ (13) dum2d
682	do j=jts,JMAX
683	do i=its,IMAX
684	psfc_in(i,j)=dum2d(i,j)
685	enddo
686	enddo
687	ELSE IF ( var_info%name(1:8) .EQ. 'PMSL ' ) THEN
688	READ (13) dum2d
689	do j=jts,JMAX
690	do i=its,IMAX
691	pmsl(i,j)=dum2d(i,j)
692	enddo
693	enddo
694	ELSE IF ( var_info%name(1:8) .EQ. 'PDTOP ' ) THEN
695	READ (13) grid%pdtop
696
697	ELSE IF ( var_info%name(1:8) .EQ. 'PT ' ) THEN
698	READ (13) grid%pt
699
700	! 2D surface fields.
701
702	ELSE IF ( var_info%name(1:8) .eq. 'GLAT ' ) THEN
703	READ (13) dum2d
704	do j=jts,JMAX
705	do i=its,IMAX
706	grid%glat(i,j)=dum2d(i,j)
707	enddo
708	enddo
709	ELSE IF ( var_info%name(1:8) .eq. 'GLON ' ) THEN
710	READ (13) dum2d
711	do j=jts,JMAX
712	do i=its,IMAX
713	grid%glon(i,j)=dum2d(i,j)
714	enddo
715	enddo
716	ELSE IF ( var_info%name(1:8) .eq. 'LAT_V ' ) THEN
717	READ (13) dum2d
718	do j=jts,JMAX
719	do i=its,IMAX
720	lat_wind(i,j)=dum2d(i,j)
721	enddo
722	enddo
723	ELSE IF ( var_info%name(1:8) .eq. 'LON_V ' ) THEN
724	READ (13) dum2d
725	do j=jts,JMAX
726	do i=its,IMAX
727	lon_wind(i,j)=dum2d(i,j)
728	enddo
729	enddo
730
731	ELSE IF ( var_info%name(1:8) .EQ. 'ST000010' ) THEN
732	READ (13) dum2d
733	do j=jts,JMAX
734	do i=its,IMAX
735	grid%st000010(i,j)=dum2d(i,j)
736	enddo
737	enddo
738	flag_st000010 = 1
739	num_st_levels_input = num_st_levels_input + 1
740	st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
741	do j=jts,JMAX
742	do i=its,IMAX
743	st_inputx(I,J,num_st_levels_input + 1) = grid%st000010(i,j)
744	enddo
745	enddo
746
747	ELSE IF ( var_info%name(1:8) .EQ. 'ST010040' ) THEN
748	READ (13) dum2d
749	do j=jts,JMAX
750	do i=its,IMAX
751	grid%st010040(i,j)=dum2d(i,j)
752	enddo
753	enddo
754	flag_st010040 = 1
755	num_st_levels_input = num_st_levels_input + 1
756	st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
757	do j=jts,JMAX
758	do i=its,IMAX
759	st_inputx(I,J,num_st_levels_input + 1) = grid%st010040(i,j)
760	enddo
761	enddo
762
763	ELSE IF ( var_info%name(1:8) .EQ. 'ST040100' ) THEN
764	READ (13) dum2d
765	do j=jts,JMAX
766	do i=its,IMAX
767	grid%st040100(i,j)=dum2d(i,j)
768	enddo
769	enddo
770	flag_st040100 = 1
771	num_st_levels_input = num_st_levels_input + 1
772	st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
773	do j=jts,JMAX
774	do i=its,IMAX
775	st_inputx(I,J,num_st_levels_input + 1) = grid%st040100(i,j)
776	enddo
777	enddo
778
779	ELSE IF ( var_info%name(1:8) .EQ. 'ST100200' ) THEN
780	READ (13) dum2d
781	do j=jts,JMAX
782	do i=its,IMAX
783	grid%st100200(i,j)=dum2d(i,j)
784	enddo
785	enddo
786	flag_st100200 = 1
787	num_st_levels_input = num_st_levels_input + 1
788	st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
789	do j=jts,JMAX
790	do i=its,IMAX
791	st_inputx(I,J,num_st_levels_input + 1) = grid%st100200(i,j)
792	enddo
793	enddo
794
795	ELSE IF ( var_info%name(1:8) .EQ. 'ST010200' ) THEN
796	READ (13) dum2d
797	do j=jts,JMAX
798	do i=its,IMAX
799	grid%st010200(i,j)=dum2d(i,j)
800	enddo
801	enddo
802	flag_st010200 = 1
803	num_st_levels_input = num_st_levels_input + 1
804	st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
805	do j=jts,JMAX
806	do i=its,IMAX
807	st_inputx(I,J,num_st_levels_input + 1) = grid%st010200(i,j)
808	enddo
809	enddo
810
811	ELSE IF ( var_info%name(1:8) .EQ. 'SM000010' ) THEN
812	READ (13) dum2d
813	do j=jts,JMAX
814	do i=its,IMAX
815	grid%sm000010(i,j)=dum2d(i,j)
816	enddo
817	enddo
818	flag_sm000010 = 1
819	num_sm_levels_input = num_sm_levels_input + 1
820	sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
821	do j=jts,JMAX
822	do i=its,IMAX
823	sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm000010(i,j)
824	enddo
825	enddo
826
827	ELSE IF ( var_info%name(1:8) .EQ. 'SM010040' ) THEN
828	READ (13) dum2d
829	do j=jts,JMAX
830	do i=its,IMAX
831	grid%sm010040(i,j)=dum2d(i,j)
832	enddo
833	enddo
834	flag_sm010040 = 1
835	num_sm_levels_input = num_sm_levels_input + 1
836	sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
837	do j=jts,JMAX
838	do i=its,IMAX
839	sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010040(i,j)
840	enddo
841	enddo
842
843	ELSE IF ( var_info%name(1:8) .EQ. 'SM040100' ) THEN
844	READ (13) dum2d
845	do j=jts,JMAX
846	do i=its,IMAX
847	grid%sm040100(i,j)=dum2d(i,j)
848	enddo
849	enddo
850	flag_sm040100 = 1
851	num_sm_levels_input = num_sm_levels_input + 1
852	sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
853	do j=jts,JMAX
854	do i=its,IMAX
855	sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm040100(i,j)
856	enddo
857	enddo
858
859	ELSE IF ( var_info%name(1:8) .EQ. 'SM100200' ) THEN
860	READ (13) dum2d
861	do j=jts,JMAX
862	do i=its,IMAX
863	grid%sm100200(i,j)=dum2d(i,j)
864	enddo
865	enddo
866	flag_sm100200 = 1
867	num_sm_levels_input = num_sm_levels_input + 1
868	sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
869	do j=jts,JMAX
870	do i=its,IMAX
871	sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm100200(i,j)
872	enddo
873	enddo
874
875	ELSE IF ( var_info%name(1:8) .EQ. 'SM010200' ) THEN
876	READ (13) dum2d
877	do j=jts,JMAX
878	do i=its,IMAX
879	grid%sm010200(i,j)=dum2d(i,j)
880	enddo
881	enddo
882	flag_sm010200 = 1
883	num_sm_levels_input = num_sm_levels_input + 1
884	sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
885	do j=jts,JMAX
886	do i=its,IMAX
887	sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010200(i,j)
888	enddo
889	enddo
890
891	ELSE IF ( var_info%name(1:8) .EQ. 'SOILT010' ) THEN
892	READ (13) dum2d
893	do j=jts,JMAX
894	do i=its,IMAX
895	soilt010_input(i,j)=dum2d(i,j)
896	enddo
897	enddo
898	flag_soilt010 = 1
899	num_st_levels_input = num_st_levels_input + 1
900	st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
901	!mp st_inputx(:,:,num_st_levels_input + 1) = soilt010_input
902	do j=jts,JMAX
903	do i=its,IMAX
904	st_inputx(I,J,num_st_levels_input + 1) = soilt010_input(I,J)
905	enddo
906	enddo
907	write(6,*) 'num_st_levels_input=',num_st_levels_input
908	ELSE IF ( var_info%name(1:8) .EQ. 'SOILT040' ) THEN
909	READ (13) dum2d
910	do j=jts,JMAX
911	do i=its,IMAX
912	soilt040_input(i,j)=dum2d(i,j)
913	enddo
914	enddo
915	flag_soilt040 = 1
916	num_st_levels_input = num_st_levels_input + 1
917	st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
918	!mp st_inputx(:,:,num_st_levels_input + 1) = soilt040_input
919	do j=jts,JMAX
920	do i=its,IMAX
921	st_inputx(I,J,num_st_levels_input + 1) = soilt040_input(I,J)
922	enddo
923	enddo
924	write(6,*) 'num_st_levels_input=',num_st_levels_input
925	ELSE IF ( var_info%name(1:8) .EQ. 'SOILT100' ) THEN
926	READ (13) dum2d
927	do j=jts,JMAX
928	do i=its,IMAX
929	soilt100_input(i,j)=dum2d(i,j)
930	enddo
931	enddo
932	flag_soilt100 = 1
933	num_st_levels_input = num_st_levels_input + 1
934	st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
935	!mp st_inputx(:,:,num_st_levels_input + 1) = soilt100_input
936	do j=jts,JMAX
937	do i=its,IMAX
938	st_inputx(I,J,num_st_levels_input + 1) = soilt100_input(I,J)
939	enddo
940	enddo
941	write(6,*) 'num_st_levels_input=',num_st_levels_input
942	ELSE IF ( var_info%name(1:8) .EQ. 'SOILT200' ) THEN
943	READ (13) dum2d
944	do j=jts,JMAX
945	do i=its,IMAX
946	soilt200_input(i,j)=dum2d(i,j)
947	enddo
948	enddo
949	flag_soilt200 = 1
950	num_st_levels_input = num_st_levels_input + 1
951	st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
952	!mp st_inputx(:,:,num_st_levels_input + 1) = soilt200_input
953	do j=jts,JMAX
954	do i=its,IMAX
955	st_inputx(I,J,num_st_levels_input + 1) = soilt200_input(I,J)
956	enddo
957	enddo
958	write(6,*) 'num_st_levels_input=',num_st_levels_input
959	ELSE IF ( var_info%name(1:8) .EQ. 'SOILM010' ) THEN
960	READ (13) dum2d
961	do j=jts,JMAX
962	do i=its,IMAX
963	soilm010_input(i,j)=dum2d(i,j)
964	enddo
965	enddo
966	flag_soilm010 = 1
967	num_sm_levels_input = num_sm_levels_input + 1
968	sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
969	!mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm010_input
970	do j=jts,JMAX
971	do i=its,IMAX
972	sm_inputx(I,J,num_sm_levels_input + 1) = soilm010_input(I,J)
973	enddo
974	enddo
975
976	ELSE IF ( var_info%name(1:8) .EQ. 'SOILM040' ) THEN
977	READ (13) dum2d
978	do j=jts,JMAX
979	do i=its,IMAX
980	soilm040_input(i,j)=dum2d(i,j)
981	enddo
982	enddo
983	flag_soilm040 = 1
984	num_sm_levels_input = num_sm_levels_input + 1
985	sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
986	!mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm040_input
987	do j=jts,JMAX
988	do i=its,IMAX
989	sm_inputx(I,J,num_sm_levels_input + 1) = soilm040_input(I,J)
990	enddo
991	enddo
992	ELSE IF ( var_info%name(1:8) .EQ. 'SOILM100' ) THEN
993	READ (13) dum2d
994	do j=jts,JMAX
995	do i=its,IMAX
996	soilm100_input(i,j)=dum2d(i,j)
997	enddo
998	enddo
999	flag_soilm100 = 1
1000	num_sm_levels_input = num_sm_levels_input + 1
1001	sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
1002	!mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm100_input
1003	do j=jts,JMAX
1004	do i=its,IMAX
1005	sm_inputx(I,J,num_sm_levels_input + 1) = soilm100_input(I,J)
1006	enddo
1007	enddo
1008
1009	ELSE IF ( var_info%name(1:8) .EQ. 'SOILM200' ) THEN
1010	READ (13) dum2d
1011	do j=jts,JMAX
1012	do i=its,IMAX
1013	soilm200_input(i,j)=dum2d(i,j)
1014	enddo
1015	enddo
1016	flag_soilm200 = 1
1017	num_sm_levels_input = num_sm_levels_input + 1
1018	sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
1019	!mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm200_input
1020	do j=jts,JMAX
1021	do i=its,IMAX
1022	sm_inputx(I,J,num_sm_levels_input + 1) = soilm200_input(I,J)
1023	enddo
1024	enddo
1025
1026	ELSE IF ( var_info%name(1:8) .EQ. 'SEAICE ' ) THEN
1027	READ (13) dum2d
1028	do j=jts,JMAX
1029	do i=its,IMAX
1030	grid%xice(i,j)=dum2d(i,j)
1031	enddo
1032	enddo
1033	ELSE IF ( var_info%name(1:8) .EQ. 'WEASD ' ) THEN
1034	READ (13) dum2d
1035	do j=jts,JMAX
1036	do i=its,IMAX
1037	grid%weasd(i,j)=dum2d(i,j)
1038	enddo
1039	enddo
1040	ELSE IF ( var_info%name(1:8) .EQ. 'CANWAT ' ) THEN
1041	READ (13) dum2d
1042	do j=jts,JMAX
1043	do i=its,IMAX
1044	grid%canwat(i,j)=dum2d(i,j)
1045	enddo
1046	enddo
1047	ELSE IF ( var_info%name(1:8) .EQ. 'LANDMASK' ) THEN
1048	READ (13) dum2d
1049	do j=jts,JMAX
1050	do i=its,IMAX
1051	grid%landmask(i,j)=dum2d(i,j)
1052	enddo
1053	enddo
1054	ELSE IF ( var_info%name(1:8) .EQ. 'SKINTEMP' ) THEN
1055	READ (13) dum2d
1056	do j=jts,JMAX
1057	do i=its,IMAX
1058	grid%nmm_tsk(i,j)=dum2d(i,j)
1059	enddo
1060	enddo
1061	ELSE IF ( var_info%name(1:8) .EQ. 'TGROUND ' ) THEN
1062	READ (13) dum2d
1063	do j=jts,JMAX
1064	do i=its,IMAX
1065	grid%tg(i,j)=dum2d(i,j)
1066	enddo
1067	enddo
1068	ELSE IF ( var_info%name(1:8) .EQ. 'SOILTB ' ) THEN
1069	READ (13) dum2d
1070	do j=jts,JMAX
1071	do i=its,IMAX
1072	grid%soiltb(i,j)=dum2d(i,j)
1073	enddo
1074	enddo
1075	ELSE IF ( var_info%name(1:8) .EQ. 'SST ' ) THEN
1076	READ (13) dum2d
1077	do j=jts,JMAX
1078	do i=its,IMAX
1079	grid%sst(i,j)=dum2d(i,j)
1080	enddo
1081	enddo
1082	flag_sst = 1
1083	ELSE IF ( var_info%name(1:8) .EQ. 'GREENFRC' ) THEN
1084	READ (13) dum2d
1085	do j=jts,JMAX
1086	do i=its,IMAX
1087	grid%vegfrc(i,j)=dum2d(i,j)
1088	enddo
1089	enddo
1090	ELSE IF ( var_info%name(1:8) .EQ. 'ISLOPE ' ) THEN
1091	READ (13) dum2d
1092	do j=jts,JMAX
1093	do i=its,IMAX
1094	grid%islope(i,j)=nint(dum2d(i,j))
1095	enddo
1096	enddo
1097	ELSE IF ( var_info%name(1:8) .EQ. 'GREENMAX' ) THEN
1098	READ (13) dum2d
1099	do j=jts,JMAX
1100	do i=its,IMAX
1101	grid%greenmax(i,j)=dum2d(i,j)
1102	enddo
1103	enddo
1104	ELSE IF ( var_info%name(1:8) .EQ. 'GREENMIN' ) THEN
1105	READ (13) dum2d
1106	do j=jts,JMAX
1107	do i=its,IMAX
1108	grid%greenmin(i,j)=dum2d(i,j)
1109	enddo
1110	enddo
1111	ELSE IF ( var_info%name(1:8) .EQ. 'FIS ' ) THEN
1112	READ (13) dum2d
1113	do j=jts,JMAX
1114	do i=its,IMAX
1115	grid%fis(i,j)=dum2d(i,j)
1116	enddo
1117	enddo
1118	ELSE IF ( var_info%name(1:8) .EQ. 'Z0 ' ) THEN
1119	! ELSE IF ( var_info%name(1:8) .EQ. 'STDEV ' ) THEN
1120	READ (13) dum2d
1121	do j=jts,JMAX
1122	do i=its,IMAX
1123	grid%z0(i,j)=dum2d(i,j)
1124	enddo
1125	enddo
1126	ELSE IF ( var_info%name(1:8) .EQ. 'CMC ' ) THEN
1127	READ (13) dum2d
1128	do j=jts,JMAX
1129	do i=its,IMAX
1130	grid%cmc(i,j)=dum2d(i,j)
1131	enddo
1132	enddo
1133	ELSE IF ( var_info%name(1:8) .EQ. 'HTM ' ) THEN
1134	READ (13) dum3d
1135	do k=kts,kte-1
1136	do j=jts,JMAX
1137	do i=its,IMAX
1138	htm_in(i,j,k)=dum3d(i,j,k)
1139	enddo
1140	enddo
1141	enddo
1142	ELSE IF ( var_info%name(1:8) .EQ. 'VTM ' ) THEN
1143	READ (13) dum3d
1144	do k=kts,kte-1
1145	do j=jts,JMAX
1146	do i=its,IMAX
1147	vtm_in(i,j,k)=dum3d(i,j,k)
1148	enddo
1149	enddo
1150	enddo
1151	ELSE IF ( var_info%name(1:8) .EQ. 'SM ' ) THEN
1152	READ (13) dum2d
1153	do j=jts,JMAX
1154	do i=its,IMAX
1155	grid%sm(i,j)=dum2d(i,j)
1156	enddo
1157	enddo
1158	ELSE IF ( var_info%name(1:8) .EQ. 'ALBASE ' ) THEN
1159	READ (13) dum2d
1160	do j=jts,JMAX
1161	do i=its,IMAX
1162	grid%albase(i,j)=dum2d(i,j)
1163	enddo
1164	enddo
1165	ELSE IF ( var_info%name(1:8) .EQ. 'MXSNAL ' ) THEN
1166	READ (13) dum2d
1167	do j=jts,JMAX
1168	do i=its,IMAX
1169	grid%mxsnal(i,j)=dum2d(i,j)
1170	enddo
1171	enddo
1172
1173	! 1D vertical coordinate.
1174
1175	ELSE IF ( var_info%name(1:8) .EQ. 'DETA ' ) THEN
1176	READ(13) DETA_in
1177	ELSE IF ( var_info%name(1:8) .EQ. 'DETA1 ' ) THEN
1178	READ(13) DETA1_in
1179	ELSE IF ( var_info%name(1:8) .EQ. 'DETA2 ' ) THEN
1180	READ(13) DETA2_in
1181	ELSE IF ( var_info%name(1:8) .EQ. 'ETAX ' ) THEN
1182	READ(13) ETAX_in
1183	ELSE IF ( var_info%name(1:8) .EQ. 'ETA1 ' ) THEN
1184	READ(13) ETA1_in
1185	ELSE IF ( var_info%name(1:8) .EQ. 'ETA2 ' ) THEN
1186	READ(13) ETA2_in
1187	ELSE IF ( var_info%name(1:8) .EQ. 'AETA ' ) THEN
1188	READ(13) AETA_in
1189	ELSE IF ( var_info%name(1:8) .EQ. 'AETA1 ' ) THEN
1190	READ(13) AETA1_in
1191	ELSE IF ( var_info%name(1:8) .EQ. 'AETA2 ' ) THEN
1192	READ(13) AETA2_in
1193	ELSE IF ( var_info%name(1:8) .EQ. 'DFL ' ) THEN
1194	READ(13) DFL_in
1195
1196	! ELSE IF ( var_info%name(1:8) .EQ. 'ETAPHALF' ) THEN
1197	! READ (13) etahalf
1198	! ELSE IF ( var_info%name(1:8) .EQ. 'ETAPFULL' ) THEN
1199	! READ (13) etafull
1200
1201	! wrong input data.
1202
1203	ELSE IF ( var_info%name(1:8) .EQ. 'ZETAFULL' ) THEN
1204	PRINT '(A)','Oops, you put in the height data.'
1205	STOP 'this_is_mass_not_height'
1206
1207
1208	! Stuff that we do not want or need is just skipped over.
1209
1210	ELSE
1211	print *,'------------------> skipping ', var_info%name(1:8)
1212	READ (13) dummy
1213	END IF
1214
1215	END DO read_all_the_data
1216
1217	CLOSE (13)
1218
1219	first_time_in = .FALSE.
1220
1221	!new
1222	sw_inputx=0.
1223	!new
1224
1225	do k=kts,kte-1
1226	do j=jts,JMAX
1227	do i=its,IMAX
1228	grid%U(I,J,K)=U_input(I,J,K)
1229	grid%V(I,J,K)=V_input(I,J,K)
1230	grid%T(I,J,K)=T_input(I,J,K)
1231	grid%Q(I,J,K)=Q_input(I,J,K)
1232	enddo
1233	enddo
1234	enddo
1235
1236	write(0,*) 'size sw_input: ', size(sw_input,dim=1),size(sw_input,dim=2),size(sw_input,dim=3)
1237	write(0,*) 'size sw_inputx: ', size(sw_inputx,dim=1),size(sw_inputx,dim=2),size(sw_inputx,dim=3)
1238	sw_input=0.
1239
1240	write(0,*) 'maxval st_inputx(1): ', maxval(st_input(:,:,1))
1241	write(0,*) 'maxval st_inputx(2): ', maxval(st_input(:,:,2))
1242	write(0,*) 'maxval st_inputx(3): ', maxval(st_input(:,:,3))
1243	write(0,*) 'maxval st_inputx(4): ', maxval(st_input(:,:,4))
1244
1245
1246	do J=JTS,min(JDE-1,JTE)
1247	do K=1,num_st_levels_alloc
1248	do I=ITS,min(IDE-1,ITE)
1249	st_input(I,K,J)=st_inputx(I,J,K)
1250	sm_input(I,K,J)=sm_inputx(I,J,K)
1251	sw_input(I,K,J)=sw_inputx(I,J,K)
1252	enddo
1253	enddo
1254	enddo
1255
1256	write(0,*) 'maxval st_input(1): ', maxval(st_input(:,1,:))
1257	write(0,*) 'maxval st_input(2): ', maxval(st_input(:,2,:))
1258	write(0,*) 'maxval st_input(3): ', maxval(st_input(:,3,:))
1259	write(0,*) 'maxval st_input(4): ', maxval(st_input(:,4,:))
1260
1261
1262	num_veg_cat = SIZE ( grid%landusef , DIM=2 )
1263	num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
1264	num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
1265
1266	do J=JTS,min(JDE-1,JTE)
1267	do K=1,num_soil_top_cat
1268	do I=ITS,min(IDE-1,ITE)
1269	grid%SOILCTOP(I,K,J)=soil_top_cat_input(I,J,K)
1270	grid%SOILCTOP_gc(I,J,K)=soil_top_cat_input(I,J,K)
1271	enddo
1272	enddo
1273	enddo
1274
1275	do J=JTS,min(JDE-1,JTE)
1276	do K=1,num_soil_bot_cat
1277	do I=ITS,min(IDE-1,ITE)
1278	grid%SOILCBOT(I,K,J)=soil_bot_cat_input(I,J,K)
1279	grid%SOILCBOT_gc(I,J,K)=soil_bot_cat_input(I,J,K)
1280	enddo
1281	enddo
1282	enddo
1283
1284	do J=JTS,min(JDE-1,JTE)
1285	do K=1,num_veg_cat
1286	do I=ITS,min(IDE-1,ITE)
1287	grid%LANDUSEF(I,K,J)=landuse_frac_input(I,J,K)
1288	grid%LANDUSEF_gc(I,J,K)=landuse_frac_input(I,J,K)
1289	enddo
1290	enddo
1291	enddo
1292
1293
1294	do K=KDS,KDE
1295	grid%ETAX(K)=ETAX_in(KDE-K+1)
1296	grid%ETA1(K)=ETA1_in(KDE-K+1)
1297	grid%ETA2(K)=ETA2_in(KDE-K+1)
1298	grid%DFL(K)=DFL_in(KDE-K+1)
1299	enddo
1300
1301	do K=KDS,KDE-1
1302	grid%DETA(K)=DETA_in(KDE-K)
1303	grid%DETA1(K)=DETA1_in(KDE-K)
1304	grid%DETA2(K)=DETA2_in(KDE-K)
1305	grid%AETA(K)=AETA_in(KDE-K)
1306	grid%AETA1(K)=AETA1_in(KDE-K)
1307	grid%AETA2(K)=AETA2_in(KDE-K)
1308	enddo
1309
1310	END SUBROUTINE read_si
1311
1312	END MODULE module_si_io_nmm

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

Download in other formats:

Original Format