input_wrf.F
References to this file elsewhere.
1 !WRF:MEDIATION:IO
2 ! ---principal wrf input routine (called from routines in module_io_domain )
3
4 SUBROUTINE input_wrf ( fid , grid , config_flags , switch , ierr )
5 USE module_domain
6 USE module_state_description
7 USE module_configure
8 USE module_io
9 USE module_io_wrf
10 USE module_date_time
11 USE module_bc_time_utilities
12 USE module_utility
13 IMPLICIT NONE
14 #include <wrf_io_flags.h>
15 #include <wrf_status_codes.h>
16 TYPE(domain) :: grid
17 TYPE(grid_config_rec_type), INTENT(INOUT) :: config_flags
18 INTEGER, INTENT(IN) :: fid
19 INTEGER, INTENT(IN) :: switch
20 INTEGER, INTENT(INOUT) :: ierr
21
22 ! Local data
23 INTEGER ids , ide , jds , jde , kds , kde , &
24 ims , ime , jms , jme , kms , kme , &
25 ips , ipe , jps , jpe , kps , kpe
26
27 INTEGER iname(9)
28 INTEGER iordering(3)
29 INTEGER icurrent_date(24)
30 INTEGER i,j,k
31 INTEGER icnt
32 INTEGER ndim
33 INTEGER ilen
34 INTEGER , DIMENSION(3) :: domain_start , domain_end
35 INTEGER , DIMENSION(3) :: memory_start , memory_end
36 INTEGER , DIMENSION(3) :: patch_start , patch_end
37 CHARACTER*256 errmess, currtimestr
38 CHARACTER*40 :: this_datestr, next_datestr
39 CHARACTER*9 NAMESTR
40 INTEGER IBDY, NAMELEN
41 LOGICAL wrf_dm_on_monitor
42 EXTERNAL wrf_dm_on_monitor
43 Type(WRFU_Time) time, currtime
44 CHARACTER*19 new_date
45 CHARACTER*24 base_date
46 CHARACTER*80 fname
47 LOGICAL dryrun
48 INTEGER idt
49 INTEGER itmp
50 INTEGER dyn_opt_tmp, dyn_opt, filestate, ierr3
51 INTEGER :: ide_compare , jde_compare , kde_compare
52 REAL , DIMENSION(16) :: lats16 , lons16
53 CHARACTER (len=19) simulation_start_date
54 INTEGER simulation_start_year , &
55 simulation_start_month , &
56 simulation_start_day , &
57 simulation_start_hour , &
58 simulation_start_minute , &
59 simulation_start_second
60 LOGICAL reset_simulation_start
61 REAL dx_compare , dy_compare , dum
62
63 !<DESCRIPTION>
64 !
65 ! Core wrf input routine for all input data streams. Part of mediation layer.
66 !
67 ! Note that WRF IOAPI routines wrf_get_dom_ti_*() do not return values during
68 ! training reads (dryrun).
69 !
70 !</DESCRIPTION>
71
72 WRITE(wrf_err_message,*)'input_wrf: begin, fid = ',fid
73 CALL wrf_debug( 300 , wrf_err_message )
74
75 ierr = 0
76
77 CALL get_ijk_from_grid ( grid , &
78 ids, ide, jds, jde, kds, kde, &
79 ims, ime, jms, jme, kms, kme, &
80 ips, ipe, jps, jpe, kps, kpe )
81
82 ! simulation start time is a Singleton maintained by head_grid
83 IF ( ( switch .EQ. model_input_only ) .OR. &
84 ( switch .EQ. restart_only ) ) THEN
85 CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , simulation_start_date , ierr )
86 CALL nl_get_reset_simulation_start ( 1, reset_simulation_start )
87 IF ( ( ierr .EQ. 0 ) .AND. ( .NOT. reset_simulation_start ) ) THEN
88 ! Overwrite simulation start date with metadata.
89 READ ( simulation_start_date , fmt = '(I4,1x,I2,1x,I2,1x,I2,1x,I2,1x,I2)' ) &
90 simulation_start_year, simulation_start_month, &
91 simulation_start_day, simulation_start_hour, &
92 simulation_start_minute, simulation_start_second
93 CALL nl_set_simulation_start_year ( 1 , simulation_start_year )
94 CALL nl_set_simulation_start_month ( 1 , simulation_start_month )
95 CALL nl_set_simulation_start_day ( 1 , simulation_start_day )
96 CALL nl_set_simulation_start_hour ( 1 , simulation_start_hour )
97 CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
98 CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
99 IF ( switch .EQ. model_input_only ) THEN
100 WRITE(wrf_err_message,*)fid,' input_wrf, model_input_only: SIMULATION_START_DATE = ', &
101 simulation_start_date(1:19)
102 CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
103 ELSE IF ( switch .EQ. restart_only ) THEN
104 WRITE(wrf_err_message,*)fid,' input_wrf, restart_only: SIMULATION_START_DATE = ', &
105 simulation_start_date(1:19)
106 CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
107 ENDIF
108 ELSE
109 CALL nl_get_start_year ( 1 , simulation_start_year )
110 CALL nl_get_start_month ( 1 , simulation_start_month )
111 CALL nl_get_start_day ( 1 , simulation_start_day )
112 CALL nl_get_start_hour ( 1 , simulation_start_hour )
113 CALL nl_get_start_minute ( 1 , simulation_start_minute )
114 CALL nl_get_start_second ( 1 , simulation_start_second )
115 CALL nl_set_simulation_start_year ( 1 , simulation_start_year )
116 CALL nl_set_simulation_start_month ( 1 , simulation_start_month )
117 CALL nl_set_simulation_start_day ( 1 , simulation_start_day )
118 CALL nl_set_simulation_start_hour ( 1 , simulation_start_hour )
119 CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
120 CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
121 IF ( reset_simulation_start ) THEN
122 CALL wrf_message('input_wrf: forcing SIMULATION_START_DATE = head_grid start time')
123 CALL wrf_message(' due to namelist variable reset_simulation_start')
124 ELSE
125 CALL wrf_message('input_wrf: SIMULATION_START_DATE not available in input')
126 CALL wrf_message('will use head_grid start time from namelist')
127 ENDIF
128 ENDIF
129 ! Initialize derived time quantity in grid%xtime.
130 ! Note that this call is also made in setup_timekeeping().
131 ! Ugh, what a hack. Simplify all this later...
132 CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
133 ! Note that it is NOT necessary to reset grid%julian here.
134 WRITE(wrf_err_message,*) 'input_wrf: set xtime to ',grid%xtime
135 CALL wrf_debug ( 100, TRIM(wrf_err_message) )
136 ENDIF
137
138
139 ! Test to make sure that the input data is the right size. Do this for input from real/ideal into
140 ! WRF, and from the standard initialization into real.
141
142 IF ( ( switch .EQ. model_input_only ) .OR. &
143 ( switch .EQ. aux_model_input1_only ) ) THEN
144 ierr = 0
145 CALL wrf_get_dom_ti_integer ( fid , 'WEST-EAST_GRID_DIMENSION' , ide_compare , 1 , icnt , ierr3 )
146 ierr = max( ierr, ierr3 )
147 CALL wrf_get_dom_ti_integer ( fid , 'SOUTH-NORTH_GRID_DIMENSION' , jde_compare , 1 , icnt , ierr3 )
148 ierr = max( ierr, ierr3 )
149 CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMENSION' , kde_compare , 1 , icnt , ierr3 )
150 ierr = max( ierr, ierr3 )
151 ! IF ( ierr3 .NE. 0 ) CALL wrf_error_fatal( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
152 IF ( ierr3 .NE. 0 ) CALL wrf_debug( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
153
154 #if (EM_CORE == 1)
155 ! Test to make sure that the grid distances are the right size.
156
157 CALL wrf_get_dom_ti_real ( fid , 'DX' , dx_compare , 1 , icnt , ierr )
158 CALL wrf_get_dom_ti_real ( fid , 'DY' , dy_compare , 1 , icnt , ierr )
159 IF ( ( ABS ( dx_compare - config_flags%dx ) .GT. 1.E-5 * dx_compare ) .OR. &
160 ( ABS ( dy_compare - config_flags%dy ) .GT. 1.E-5 * dy_compare ) ) THEN
161 print *,'dx_compare,dy_compare = ',dx_compare,dy_compare
162 CALL wrf_error_fatal( 'DX and DY do not match from the namelist and the input file' )
163 END IF
164 #endif
165 END IF
166
167 ! do the check later (see check_if_dryrun below)
168
169 CALL nl_get_dyn_opt( 1, dyn_opt )
170 CALL wrf_get_dom_ti_integer ( fid, 'DYN_OPT', dyn_opt_tmp, 1, icnt, ierr )
171
172 ! We do not want the CEN_LAT LON values from the boundary file. For 1-way nests
173 ! with ndown, this ends up being the data from the previous coarse domain.
174
175 IF ( switch .NE. boundary_only ) THEN
176 CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , config_flags%cen_lat , 1 , icnt , ierr )
177 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',config_flags%cen_lat
178 CALL wrf_debug ( 300 , wrf_err_message )
179 CALL nl_set_cen_lat ( grid%id , config_flags%cen_lat )
180
181 CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , config_flags%cen_lon , 1 , icnt , ierr )
182 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',config_flags%cen_lon
183 CALL wrf_debug ( 300 , wrf_err_message )
184 CALL nl_set_cen_lon ( grid%id , config_flags%cen_lon )
185 ELSE
186 CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , dum , 1 , icnt , ierr )
187 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',dum
188 CALL wrf_debug ( 300 , wrf_err_message )
189
190 CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , dum , 1 , icnt , ierr )
191 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',dum
192 CALL wrf_debug ( 300 , wrf_err_message )
193 END IF
194
195 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' , config_flags%truelat1 , 1 , icnt , ierr )
196 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT1 returns ',config_flags%truelat1
197 CALL wrf_debug ( 300 , wrf_err_message )
198 CALL nl_set_truelat1 ( grid%id , config_flags%truelat1 )
199
200 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' , config_flags%truelat2 , 1 , icnt , ierr )
201 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT2 returns ',config_flags%truelat2
202 CALL wrf_debug ( 300 , wrf_err_message )
203 CALL nl_set_truelat2 ( grid%id , config_flags%truelat2 )
204
205 CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' , config_flags%moad_cen_lat , 1 , icnt , ierr )
206 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for MOAD_CEN_LAT returns ',config_flags%moad_cen_lat
207 CALL wrf_debug ( 300 , wrf_err_message )
208 CALL nl_set_moad_cen_lat ( grid%id , config_flags%moad_cen_lat )
209
210 CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' , config_flags%stand_lon , 1 , icnt , ierr )
211 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for STAND_LON returns ',config_flags%stand_lon
212 CALL wrf_debug ( 300 , wrf_err_message )
213 CALL nl_set_stand_lon ( grid%id , config_flags%stand_lon )
214
215 #if ( NMM_CORE != 1 )
216 IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
217 CALL wrf_get_dom_ti_real ( fid , 'corner_lats' , lats16 , 16 , icnt , ierr )
218 WRITE(wrf_err_message,FMT='(A,16f6.1)')'input_wrf: wrf_get_dom_ti_real for CORNER_LATS returns ',lats16
219 CALL wrf_debug ( 300 , wrf_err_message )
220 grid%em_lat_ll_t = lats16( 1)
221 grid%em_lat_ul_t = lats16( 2)
222 grid%em_lat_ur_t = lats16( 3)
223 grid%em_lat_lr_t = lats16( 4)
224 grid%em_lat_ll_u = lats16( 5)
225 grid%em_lat_ul_u = lats16( 6)
226 grid%em_lat_ur_u = lats16( 7)
227 grid%em_lat_lr_u = lats16( 8)
228 grid%em_lat_ll_v = lats16( 9)
229 grid%em_lat_ul_v = lats16(10)
230 grid%em_lat_ur_v = lats16(11)
231 grid%em_lat_lr_v = lats16(12)
232 grid%em_lat_ll_d = lats16(13)
233 grid%em_lat_ul_d = lats16(14)
234 grid%em_lat_ur_d = lats16(15)
235 grid%em_lat_lr_d = lats16(16)
236
237 CALL wrf_get_dom_ti_real ( fid , 'corner_lons' , lons16 , 16 , icnt , ierr )
238 WRITE(wrf_err_message,FMT='(A,16f6.1)')'input_wrf: wrf_get_dom_ti_real for CORNER_LONS returns ',lons16
239 CALL wrf_debug ( 300 , wrf_err_message )
240 grid%em_lon_ll_t = lons16( 1)
241 grid%em_lon_ul_t = lons16( 2)
242 grid%em_lon_ur_t = lons16( 3)
243 grid%em_lon_lr_t = lons16( 4)
244 grid%em_lon_ll_u = lons16( 5)
245 grid%em_lon_ul_u = lons16( 6)
246 grid%em_lon_ur_u = lons16( 7)
247 grid%em_lon_lr_u = lons16( 8)
248 grid%em_lon_ll_v = lons16( 9)
249 grid%em_lon_ul_v = lons16(10)
250 grid%em_lon_ur_v = lons16(11)
251 grid%em_lon_lr_v = lons16(12)
252 grid%em_lon_ll_d = lons16(13)
253 grid%em_lon_ul_d = lons16(14)
254 grid%em_lon_ur_d = lons16(15)
255 grid%em_lon_lr_d = lons16(16)
256 ENDIF
257 #endif
258
259 #if ( NMM_CORE != 1 )
260 ! program_name is defined in module_domain and set in the main program for whatever application
261 ! is using subroutine input_wrf (that is, the subroutine you are looking at here). Data files
262 ! written by SI have P_TOP as a metadata item; the real program and wrf model have it as a
263 ! state variable. This test is to supress non-fatal but confusing messages from the model complaining
264 ! that P_TOP cannot be read from the metadata for this dataset. JM 20040905
265 !
266 ! Note, P_TOP is not defined in the NMM core.
267
268 IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
269 CALL wrf_get_dom_ti_real ( fid , 'P_TOP' , grid%p_top , 1 , icnt , ierr )
270 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for P_TOP returns ',grid%p_top
271 CALL wrf_debug ( 300 , wrf_err_message )
272 ENDIF
273 #endif
274
275 IF ( switch .NE. boundary_only ) THEN
276 CALL wrf_get_dom_ti_real ( fid , 'GMT' , config_flags%gmt , 1 , icnt , ierr )
277 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for GMT returns ',config_flags%gmt
278 CALL wrf_debug ( 300 , wrf_err_message )
279 CALL nl_set_gmt ( grid%id , config_flags%gmt )
280
281 CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , config_flags%julyr , 1 , icnt , ierr )
282 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULYR returns ',config_flags%julyr
283 CALL wrf_debug ( 300 , wrf_err_message )
284 CALL nl_set_julyr ( grid%id , config_flags%julyr )
285
286 CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , config_flags%julday , 1 , icnt , ierr )
287 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULDAY returns ',config_flags%julday
288 CALL wrf_debug ( 300 , wrf_err_message )
289 CALL nl_set_julday ( grid%id , config_flags%julday )
290 ENDIF
291
292 CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , config_flags%map_proj , 1 , icnt , ierr )
293 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for MAP_PROJ returns ',config_flags%map_proj
294 CALL wrf_debug ( 300 , wrf_err_message )
295 CALL nl_set_map_proj ( grid%id , config_flags%map_proj )
296
297 CALL wrf_get_dom_ti_char ( fid , 'MMINLU', mminlu , ierr )
298 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_char for MMINLU returns ',mminlu(1:4)
299 CALL wrf_debug ( 300 , wrf_err_message )
300 CALL nl_set_mminlu ( 1, mminlu(1:4) )
301
302 CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , config_flags%iswater , 1 , icnt , ierr )
303 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISWATER returns ',config_flags%iswater
304 CALL wrf_debug ( 300 , wrf_err_message )
305 IF ( ierr .NE. 0 ) THEN
306 IF (mminlu == 'UMD') THEN
307 config_flags%iswater = 14
308 ELSE
309 config_flags%iswater = 16
310 ENDIF
311 ENDIF
312 CALL nl_set_iswater ( grid%id , config_flags%iswater )
313
314 CALL wrf_get_dom_ti_integer ( fid , 'ISICE' , config_flags%isice , 1 , icnt , ierr )
315 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISICE returns ',config_flags%isice
316 CALL wrf_debug ( 300 , wrf_err_message )
317 IF ( ierr .NE. 0 ) THEN
318 IF (mminlu == 'UMD') THEN
319 config_flags%isice = 14
320 ELSE
321 config_flags%isice = 24
322 ENDIF
323 ENDIF
324 CALL nl_set_isice ( grid%id , config_flags%isice )
325
326 CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' , config_flags%isurban , 1 , icnt , ierr )
327 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISURBAN returns ',config_flags%isurban
328 CALL wrf_debug ( 300 , wrf_err_message )
329 IF ( ierr .NE. 0 ) THEN
330 IF (mminlu == 'UMD') THEN
331 config_flags%isurban = 13
332 ELSE
333 config_flags%isurban = 1
334 ENDIF
335 ENDIF
336 CALL nl_set_isurban ( grid%id , config_flags%isurban )
337
338 CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' , config_flags%isoilwater , 1 , icnt , ierr )
339 WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISOILWATER returns ',config_flags%isoilwater
340 CALL wrf_debug ( 300 , wrf_err_message )
341 IF ( ierr .NE. 0 ) THEN
342 config_flags%isoilwater = 14
343 ENDIF
344 CALL nl_set_isoilwater ( grid%id , config_flags%isoilwater )
345
346 #ifdef MOVE_NESTS
347 ! Added these fields for restarting of moving nests, JM
348 ! DANGER and TODO
349 ! It is very important that these be set correctly if they are set at all in here.
350 ! Garbage values will produce unpredictable results, possibly segfaults, in the nesting
351 ! code. Need some integrity checking here or elsewhere in the code to at least check to
352 ! make sure that the istart and jstart values make sense with respect to the nest dimensions
353 ! and the position in the parent domain.
354 CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' , itmp , 1 , icnt, ierr )
355 IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
356 config_flags%i_parent_start = itmp
357 CALL nl_set_i_parent_start ( grid%id , config_flags%i_parent_start )
358 ENDIF
359 CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' , itmp , 1 , icnt, ierr )
360 IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
361 config_flags%j_parent_start = itmp
362 CALL nl_set_j_parent_start ( grid%id , config_flags%j_parent_start )
363 ENDIF
364 #endif
365
366 ! If this was not a training read (dry run) check for erroneous values.
367 CALL wrf_inquire_filename ( fid , fname , filestate , ierr )
368 IF ( ierr /= 0 ) THEN
369 WRITE(wrf_err_message,*)'module_io_wrf: input_wrf: wrf_inquire_filename Status = ',ierr
370 CALL wrf_error_fatal( wrf_err_message )
371 ENDIF
372
373 WRITE(wrf_err_message,*)'input_wrf: fid,filestate = ',fid,filestate
374 CALL wrf_debug( 300 , wrf_err_message )
375
376 dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
377
378 WRITE(wrf_err_message,*)'input_wrf: dryrun = ',dryrun
379 CALL wrf_debug( 300 , wrf_err_message )
380
381 check_if_dryrun : IF ( .NOT. dryrun ) THEN
382
383 #if (EM_CORE == 1)
384
385 !KLUDGE - is there a more elegant way to determine "old si" input
386 IF ( ( switch .EQ. model_input_only ) .OR. &
387 ( ( switch .EQ. aux_model_input1_only ) .AND. &
388 ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) ) THEN
389
390 ! Test to make sure that the input data is the right size.
391
392 IF ( ( ide .NE. ide_compare ) .OR. &
393 ( kde .NE. kde_compare ) .OR. &
394 ( jde .NE. jde_compare ) ) THEN
395 WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: namelist ide,jde,kde=',ide,jde,kde,&
396 '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
397 CALL wrf_error_fatal( wrf_err_message )
398 ENDIF
399
400 ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
401
402 ! Test to make sure that the input data is the right size.
403
404 IF ( ( ide .NE. ide_compare ) .OR. &
405 ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
406 ( jde .NE. jde_compare ) ) THEN
407 WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: ',&
408 'namelist ide,jde,num_metgrid_levels=',ide,jde,config_flags%num_metgrid_levels,&
409 '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
410 CALL wrf_error_fatal( wrf_err_message )
411 ENDIF
412 ENDIF
413
414 #endif
415
416 #if (NMM_CORE == 1)
417
418 IF ( ( switch .EQ. aux_model_input1_only ) .AND. &
419 ( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) THEN
420
421 CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMSNSION' , kde_compare , 1 , icnt , ierr3 )
422
423 ! Test to make sure that the input data is the right size.
424
425 IF ( ( ide-1 .NE. ide_compare ) .OR. &
426 ( kde .NE. kde_compare ) .OR. &
427 ( jde-1 .NE. jde_compare ) .AND. ierr3 .EQ. 0 ) THEN
428 WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: namelist ide-1,jde-1,kde=',ide-1,jde-1,kde,&
429 '; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
430 CALL wrf_debug( 100, wrf_err_message )
431 ENDIF
432
433 ELSEIF ( switch .EQ. aux_model_input1_only ) THEN ! assume just WPS in this branch
434 IF ( ( ide-1 .NE. ide_compare ) .OR. &
435 ( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
436 ( jde-1 .NE. jde_compare ) .AND. ierr3 .EQ. 0 ) THEN
437 WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: ',&
438 'namelist ide-1,jde-1,num_metgrid_levels=',ide-1,jde-1,config_flags%num_metgrid_levels,&
439 '; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
440 IF (ide-1 .eq. ide_compare .AND. jde-1 .EQ. jde_compare) THEN
441 CALL wrf_message(wrf_err_message)
442 CALL wrf_error_fatal( "appears that the vertical dimension is wrong - quitting" )
443 ELSE
444 CALL wrf_message(wrf_err_message)
445 CALL wrf_error_fatal( "appears that I or J dimensions are wrong - quitting" )
446 ENDIF
447 ENDIF
448 ENDIF
449
450 #endif
451
452
453 IF ( dyn_opt_tmp .NE. dyn_opt .AND. switch .EQ. model_input_only ) THEN
454 WRITE(wrf_err_message,*)'input_wrf: dyn_opt in file ',dyn_opt_tmp,' NE namelist ',dyn_opt
455 CALL wrf_error_fatal( wrf_err_message )
456 ENDIF
457
458 ENDIF check_if_dryrun
459
460 !
461 ! This call to wrf_get_next_time will position the dataset over the next time-frame
462 ! in the file and return the current_date, which is used as an argument to the
463 ! read_field routines in the blocks of code included below. Note that we read the
464 ! next time *after* all the meta data has been read. This is only important for the
465 ! WRF internal I/O format because it is order-dependent. Other formats shouldn't care
466 ! about this.
467 !
468
469 3003 continue
470
471 CALL wrf_get_next_time(fid, current_date , ierr)
472 WRITE(wrf_err_message,*)fid,' input_wrf: wrf_get_next_time current_date: ',current_date(1:19),' Status = ',ierr
473 CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
474 IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
475 CALL wrf_message ( TRIM(wrf_err_message ) )
476 IF ( switch .EQ. boundary_only ) THEN
477 WRITE(wrf_err_message,*) ' ... May have run out of valid boundary conditions in file ',TRIM(fname)
478 CALL wrf_error_fatal( TRIM(wrf_err_message) )
479 ELSE
480 #if ( NMM_CORE != 1 )
481 WRITE(wrf_err_message,*) '... Could not find matching time in input file ',TRIM(fname)
482 CALL wrf_error_fatal( TRIM(wrf_err_message) )
483 #endif
484 ENDIF
485 ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ) THEN
486 !
487 ! check input time against domain time (which will be start time at beginning, see share/set_timekeeping.F)
488 ! JM 20040511
489 !
490 SELECT CASE ( switch )
491 CASE ( model_input_only, aux_model_input1_only, aux_model_input2_only, &
492 aux_model_input3_only, aux_model_input4_only, aux_model_input5_only, aux_model_input10_only )
493 #ifdef WRF_CHEM
494 IF( (config_flags%io_style_emissions .eq. 1) .and. &
495 ((switch.eq.aux_model_input4_only) .or. (switch.eq.aux_model_input5_only)) )then
496 CALL wrf_message( "**WARNING** Time in input file not being checked **WARNING**" )
497 ELSE
498 #endif
499 CALL wrf_atotime( current_date(1:19), time )
500 CALL domain_clock_get( grid, current_time=currtime, &
501 current_timestr=currtimestr )
502 #if (DA_CORE != 1)
503 ! Don't perform the check for WRFVAR, as we're not passing the right dates
504 ! around
505 CALL domain_clockprint(150, grid, &
506 'DEBUG input_wrf(): get CurrTime from clock,')
507 IF ( time .NE. currtime ) THEN
508 WRITE( wrf_err_message , * )'Time in file: ',trim( current_date(1:19) )
509 CALL wrf_message ( trim(wrf_err_message) )
510 WRITE( wrf_err_message , * )'Time on domain: ',trim( currtimestr )
511 CALL wrf_message ( trim(wrf_err_message) )
512 CALL wrf_message( "**WARNING** Time in input file not equal to time on domain **WARNING**" )
513 WRITE(wrf_err_message,*) "**WARNING** Trying next time in file ",TRIM(fname)," ..."
514 CALL wrf_message( TRIM(wrf_err_message) )
515 GOTO 3003
516 ENDIF
517 #endif
518 #ifdef WRF_CHEM
519 ENDIF
520 #endif
521 CASE DEFAULT
522 END SELECT
523 ENDIF
524
525 ! set the lbc time interval fields in the domain data structure
526 ! these time values are checked as stopping condition for the while loop in
527 ! latbound_in() defined in share/medation_integrate.F, which is used to
528 ! iterate forward to the correct interval in the input LBC file
529 !
530 IF ( switch .EQ. boundary_only ) THEN
531 CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' , current_date(1:19), this_datestr , ierr )
532 CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
533 CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' , current_date(1:19), next_datestr , ierr )
534 CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
535 ENDIF
536
537 #if 1
538 IF ( switch .EQ. model_input_only ) THEN
539 CALL wrf_inputin( fid , grid , config_flags , switch , ierr )
540 ELSE IF ( switch .EQ. history_only ) THEN
541 CALL wrf_histin( fid , grid , config_flags , switch , ierr )
542 ELSE IF ( switch .EQ. aux_model_input1_only ) THEN
543 CALL wrf_auxinput1in( fid , grid , config_flags , switch , ierr )
544 ELSE IF ( switch .EQ. aux_model_input2_only ) THEN
545 CALL wrf_auxinput2in( fid , grid , config_flags , switch , ierr )
546 ELSE IF ( switch .EQ. aux_model_input3_only ) THEN
547 CALL wrf_auxinput3in( fid , grid , config_flags , switch , ierr )
548 ELSE IF ( switch .EQ. aux_model_input4_only ) THEN
549 CALL wrf_auxinput4in( fid , grid , config_flags , switch , ierr )
550 ELSE IF ( switch .EQ. aux_model_input5_only ) THEN
551 CALL wrf_auxinput5in( fid , grid , config_flags , switch , ierr )
552 ELSE IF ( switch .EQ. aux_model_input6_only ) THEN
553 CALL wrf_auxinput6in( fid , grid , config_flags , switch , ierr )
554 ELSE IF ( switch .EQ. aux_model_input7_only ) THEN
555 CALL wrf_auxinput7in( fid , grid , config_flags , switch , ierr )
556 ELSE IF ( switch .EQ. aux_model_input8_only ) THEN
557 CALL wrf_auxinput8in( fid , grid , config_flags , switch , ierr )
558 ELSE IF ( switch .EQ. aux_model_input9_only ) THEN
559 CALL wrf_auxinput9in( fid , grid , config_flags , switch , ierr )
560 ELSE IF ( switch .EQ. aux_model_input10_only ) THEN
561 CALL wrf_auxinput10in( fid , grid , config_flags , switch , ierr )
562 ELSE IF ( switch .EQ. aux_model_input11_only ) THEN
563 CALL wrf_auxinput11in( fid , grid , config_flags , switch , ierr )
564
565
566 ELSE IF ( switch .EQ. aux_hist1_only ) THEN
567 CALL wrf_auxhist1in( fid , grid , config_flags , switch , ierr )
568 ELSE IF ( switch .EQ. aux_hist2_only ) THEN
569 CALL wrf_auxhist2in( fid , grid , config_flags , switch , ierr )
570 ELSE IF ( switch .EQ. aux_hist3_only ) THEN
571 CALL wrf_auxhist3in( fid , grid , config_flags , switch , ierr )
572 ELSE IF ( switch .EQ. aux_hist4_only ) THEN
573 CALL wrf_auxhist4in( fid , grid , config_flags , switch , ierr )
574 ELSE IF ( switch .EQ. aux_hist5_only ) THEN
575 CALL wrf_auxhist5in( fid , grid , config_flags , switch , ierr )
576 ELSE IF ( switch .EQ. aux_hist6_only ) THEN
577 CALL wrf_auxhist6in( fid , grid , config_flags , switch , ierr )
578 ELSE IF ( switch .EQ. aux_hist7_only ) THEN
579 CALL wrf_auxhist7in( fid , grid , config_flags , switch , ierr )
580 ELSE IF ( switch .EQ. aux_hist8_only ) THEN
581 CALL wrf_auxhist8in( fid , grid , config_flags , switch , ierr )
582 ELSE IF ( switch .EQ. aux_hist9_only ) THEN
583 CALL wrf_auxhist9in( fid , grid , config_flags , switch , ierr )
584 ELSE IF ( switch .EQ. aux_hist10_only ) THEN
585 CALL wrf_auxhist10in( fid , grid , config_flags , switch , ierr )
586 ELSE IF ( switch .EQ. aux_hist11_only ) THEN
587 CALL wrf_auxhist11in( fid , grid , config_flags , switch , ierr )
588
589 ELSE IF ( switch .EQ. restart_only ) THEN
590 CALL wrf_restartin( fid , grid , config_flags , switch , ierr )
591 ELSE IF ( switch .EQ. boundary_only ) THEN
592 CALL wrf_bdyin( fid , grid , config_flags , switch , ierr )
593 ENDIF
594 #else
595 CALL wrf_message ( "ALL I/O DISABLED IN share/module_io_wrf.F")
596 #endif
597
598 WRITE(wrf_err_message,*)'input_wrf: end, fid = ',fid
599 CALL wrf_debug( 300 , wrf_err_message )
600
601 RETURN
602 END SUBROUTINE input_wrf