module_si_io_nmm.F
References to this file elsewhere.
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