Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

input_wrf.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 26.8 KB

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

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

Download in other formats:

Original Format