Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_si_io_nmm.F @ 3567

Last change on this file since 3567 was 11, checked in by aslmd, 14 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 50.8 KB

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

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

Download in other formats:

Original Format