Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

input_wrf.F @ 3709

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

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

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

Download in other formats:

Original Format