Context Navigation

input_wrf.F.v3.6.1

Last change on this file was 593, checked in by lfita, 10 years ago
Adding version 3.6.1
File size: 80.4 KB

Rev	Line
[593]	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	TYPE( fieldlist ), POINTER :: p
	28
	29	INTEGER newswitch, itrace
	30
	31	INTEGER iname(9)
	32	INTEGER iordering(3)
	33	INTEGER icurrent_date(24)
	34	INTEGER i,j,k
	35	INTEGER icnt
	36	INTEGER ndim
	37	INTEGER ilen
	38	INTEGER , DIMENSION(3) :: domain_start , domain_end
	39	INTEGER , DIMENSION(3) :: memory_start , memory_end
	40	INTEGER , DIMENSION(3) :: patch_start , patch_end
	41	CHARACTER*256 errmess, currtimestr
	42	CHARACTER*40 :: this_datestr, next_datestr
	43	CHARACTER*9 NAMESTR
	44	INTEGER IBDY, NAMELEN
	45	LOGICAL wrf_dm_on_monitor
	46	EXTERNAL wrf_dm_on_monitor
	47	Type(WRFU_Time) time, currtime, currentTime
	48	CHARACTER*19 new_date
	49	CHARACTER*24 base_date
	50	CHARACTER*80 fname
	51	CHARACTER*80 dname, memord
	52	LOGICAL dryrun
	53	INTEGER idt
	54	INTEGER itmp
	55	INTEGER filestate, ierr3
	56	INTEGER :: ide_compare , jde_compare , kde_compare
	57	CHARACTER (len=19) simulation_start_date , first_date_input , first_date_nml
	58	INTEGER first_date_start_year , &
	59	first_date_start_month , &
	60	first_date_start_day , &
	61	first_date_start_hour , &
	62	first_date_start_minute , &
	63	first_date_start_second
	64	INTEGER simulation_start_year , &
	65	simulation_start_month , &
	66	simulation_start_day , &
	67	simulation_start_hour , &
	68	simulation_start_minute , &
	69	simulation_start_second
	70	LOGICAL reset_simulation_start
	71	REAL dx_compare , dy_compare , dum
	72	INTEGER :: num_land_cat_compare
	73	CHARACTER (LEN=256) :: MMINLU
	74
	75	! Local variables for vertical interpolation.
	76
	77	REAL, ALLOCATABLE, DIMENSION(: ) :: f_vint_1d
	78	REAL, ALLOCATABLE, DIMENSION(:,:,: ) :: f_vint_3d
	79	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: f_vint_4d
	80	integer :: ed1_c,em1_c,ep1_c
	81	integer :: ed2_c,em2_c,ep2_c
	82	integer :: n_ref_m,i_inter
	83
	84	! Local variables for the alarms in the input restart file.
	85
	86	INTEGER max_wrf_alarms_compare, seconds
	87	CHARACTER*80 alarmname, timestr
	88	TYPE(WRFU_Time) :: curtime, ringTime
	89	TYPE(WRFU_TimeInterval) :: interval, interval2
	90	integer s, iring
	91
	92	! Local variables: are we are using the correct hypsometric option for ARW ideal cases.
	93
	94	CHARACTER (LEN=80) :: input_name
	95	LOGICAL :: this_is_an_ideal_run
	96	INTEGER :: loop, hypsometric_opt
	97
	98	CHARACTER (LEN=256) :: a_message
	99
	100
	101	!<DESCRIPTION>
	102	!
	103	! Core wrf input routine for all input data streams. Part of mediation layer.
	104	!
	105	! Note that WRF IOAPI routines wrf_get_dom_ti_*() do not return values during
	106	! training reads (dryrun).
	107	!
	108	!</DESCRIPTION>
	109
	110	WRITE(wrf_err_message,*)'input_wrf: begin, fid = ',fid
	111	CALL wrf_debug( 300 , wrf_err_message )
	112
	113	CALL modify_io_masks ( grid%id ) ! this adjusts the I/O masks according to the users run-time specs, if any
	114
	115	ierr = 0
	116
	117	CALL get_ijk_from_grid ( grid , &
	118	ids, ide, jds, jde, kds, kde, &
	119	ims, ime, jms, jme, kms, kme, &
	120	ips, ipe, jps, jpe, kps, kpe )
	121
	122	! If this was not a training read (dry run) check for erroneous values.
	123	CALL wrf_inquire_filename ( fid , fname , filestate , ierr )
	124	IF ( ierr /= 0 ) THEN
	125	WRITE(wrf_err_message,*)'module_io_wrf: input_wrf: wrf_inquire_filename Status = ',ierr
	126	CALL wrf_error_fatal( wrf_err_message )
	127	ENDIF
	128
	129	WRITE(wrf_err_message,*)'input_wrf: fid,filestate = ',fid,filestate
	130	CALL wrf_debug( 300 , wrf_err_message )
	131
	132	dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
	133
	134	WRITE(wrf_err_message,*)'input_wrf: dryrun = ',dryrun,' switch ',switch
	135	CALL wrf_debug( 300 , wrf_err_message )
	136
	137	check_if_dryrun : IF ( .NOT. dryrun ) THEN
	138
	139	#if (EM_CORE == 1)
	140	IF ( switch .EQ. input_only ) THEN
	141
	142	! Make sure for ARW ideal cases that the hypsometric option, the
	143	! way that we integrate the heigh field, is set to 1. This is the
	144	! method that is used in all of the "ideal" programs to get the
	145	! base-state height (phb).
	146
	147	CALL wrf_get_dom_ti_char ( fid , 'TITLE' , input_name , ierr )
	148	grid%this_is_an_ideal_run = INDEX(TRIM(input_name) , 'IDEAL' ) .NE. 0
	149	IF ( grid%this_is_an_ideal_run ) THEN
	150	grid%hypsometric_opt = 1
	151	config_flags%hypsometric_opt = 1
	152	DO loop = 1 , grid%max_dom
	153	CALL nl_set_hypsometric_opt ( loop , 1 )
	154	END DO
	155	WRITE(wrf_err_message,*)'Ideal cases do not support the hypsometric option.'
	156	CALL wrf_debug( 0 , wrf_err_message )
	157	END IF
	158	END IF
	159	#endif
	160
	161	! INPUT ONLY (KK)
	162
	163	IF ( switch .EQ. restart_only ) THEN
	164
	165	! recover the restart alarms from input if available
	166
	167	CALL wrf_get_dom_ti_integer( fid , 'MAX_WRF_ALARMS', max_wrf_alarms_compare, 1, icnt, ierr )
	168	IF ( max_wrf_alarms_compare .NE. MAX_WRF_ALARMS ) THEN
	169	WRITE(wrf_err_message,*)'MAX_WRF_ALARMS different in restart file (',max_wrf_alarms_compare,&
	170	') from in code (',MAX_WRF_ALARMS,'). Disregarding info in restart file.'
	171	ELSE
	172	curtime = domain_get_current_time( grid )
	173	DO i = auxinput1_only, MAX_WRF_ALARMS
	174	IF ( grid%alarms_created(i) .AND. .NOT. i .EQ. boundary_only ) THEN
	175	write(alarmname,'("WRF_ALARM_ISRINGING_",i2.2)')i
	176	CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), iring, 1, icnt, ierr )
	177
	178	write(alarmname,'("WRF_ALARM_SECS_TIL_NEXT_RING_",i2.2)')i
	179	CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), seconds, 1, icnt, ierr )
	180	IF ( ierr .EQ. 0 &
	181	.AND. seconds .GE. 0 ) THEN ! disallow negative intervals; can happen with wrfbdy datasets
	182	! which keep time differently
	183
	184	! Get and set interval so that we are sure to have both the
	185	! interval and first ring time set correctly
	186	CALL WRFU_AlarmGet( grid%alarms(i), ringinterval=interval2 )
	187
	188	IF (config_flags%override_restart_timers) THEN
	189	IF (i .EQ. restart_only) THEN
	190	seconds = grid%restart_interval_d * 86400 + &
	191	grid%restart_interval_h * 3600 + &
	192	grid%restart_interval_m * 60 + &
	193	grid%restart_interval * 60 + &
	194	grid%restart_interval_s
	195	ENDIF
	196	ENDIF
	197
	198	CALL WRFU_TimeIntervalSet(interval,S=seconds)
	199	ringTime = curtime + interval
	200	CALL WRFU_AlarmSet( grid%alarms(i), RingInterval=interval2, RingTime=ringTime )
	201
	202	ENDIF
	203
	204	IF ( iring .EQ. 1 ) THEN
	205	CALL WRFU_AlarmRingerOn( grid%alarms( i ) )
	206	ELSE
	207	CALL WRFU_AlarmRingerOff( grid%alarms( i ) )
	208	ENDIF
	209	ENDIF
	210	ENDDO
	211	ENDIF
	212
	213
	214	!OUTPUT ONLY (KK)
	215
	216	IF ( switch .EQ. restart_only .AND. .NOT. config_flags%override_restart_timers ) THEN
	217
	218	! recover the restart alarms from input if available
	219
	220	CALL wrf_get_dom_ti_integer( fid , 'MAX_WRF_ALARMS', max_wrf_alarms_compare, 1, icnt, ierr )
	221	IF ( max_wrf_alarms_compare .NE. MAX_WRF_ALARMS ) THEN
	222	WRITE(wrf_err_message,*)'MAX_WRF_ALARMS different in restart file (',max_wrf_alarms_compare,&
	223	') from in code (',MAX_WRF_ALARMS,'). Disregarding info in restart file.'
	224	ELSE
	225	curtime = domain_get_current_time( grid )
	226	DO i = 1, auxinput1_only-1
	227	IF ( grid%alarms_created(i) .AND. .NOT. i .EQ. boundary_only ) THEN
	228	write(alarmname,'("WRF_ALARM_ISRINGING_",i2.2)')i
	229	CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), iring, 1, icnt, ierr )
	230
	231	write(alarmname,'("WRF_ALARM_SECS_TIL_NEXT_RING_",i2.2)')i
	232	CALL wrf_get_dom_ti_integer( fid, TRIM(alarmname), seconds, 1, icnt, ierr )
	233	IF ( ierr .EQ. 0 &
	234	.AND. seconds .GE. 0 ) THEN ! disallow negative intervals; can happen with wrfbdy datasets
	235	! which keep time differently
	236
	237	! Get and set interval so that we are sure to have both the
	238	! interval and first ring time set correctly
	239	CALL WRFU_AlarmGet( grid%alarms(i), ringinterval=interval2 )
	240
	241	IF (config_flags%override_restart_timers) THEN
	242	IF (i .EQ. history_only) THEN
	243	seconds = grid%history_interval_d * 86400 + &
	244	grid%history_interval_h * 3600 + &
	245	grid%history_interval_m * 60 + &
	246	grid%history_interval * 60 + &
	247	grid%history_interval_s
	248	ENDIF
	249	ENDIF
	250
	251	CALL WRFU_TimeIntervalSet(interval,S=seconds)
	252	ringTime = curtime + interval
	253	CALL WRFU_AlarmSet( grid%alarms(i), RingInterval=interval, RingTime=ringTime )
	254
	255	ENDIF
	256
	257	IF ( iring .EQ. 1 ) THEN
	258	CALL WRFU_AlarmRingerOn( grid%alarms( i ) )
	259	ELSE
	260	CALL WRFU_AlarmRingerOff( grid%alarms( i ) )
	261	ENDIF
	262	ENDIF
	263	ENDDO
	264	ENDIF
	265
	266	ENDIF
	267
	268	CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , simulation_start_date , ierr )
	269	CALL nl_get_reset_simulation_start ( 1, reset_simulation_start )
	270	IF ( ( ierr .EQ. 0 ) .AND. ( .NOT. reset_simulation_start ) ) THEN
	271	! Overwrite simulation start date with metadata.
	272	#ifdef PLANET
	273	READ ( simulation_start_date , fmt = '(I4,1x,I5,1x,I2,1x,I2,1x,I2)' ) &
	274	simulation_start_year, &
	275	simulation_start_day, simulation_start_hour, &
	276	simulation_start_minute, simulation_start_second
	277	simulation_start_month = 0
	278	#else
	279	READ ( simulation_start_date , fmt = '(I4,1x,I2,1x,I2,1x,I2,1x,I2,1x,I2)' ) &
	280	simulation_start_year, simulation_start_month, &
	281	simulation_start_day, simulation_start_hour, &
	282	simulation_start_minute, simulation_start_second
	283	#endif
	284	CALL nl_set_simulation_start_year ( 1 , simulation_start_year )
	285	CALL nl_set_simulation_start_month ( 1 , simulation_start_month )
	286	CALL nl_set_simulation_start_day ( 1 , simulation_start_day )
	287	CALL nl_set_simulation_start_hour ( 1 , simulation_start_hour )
	288	CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
	289	CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
	290	IF ( switch .EQ. input_only ) THEN
	291	WRITE(wrf_err_message,*)fid,' input_wrf, input_only: SIMULATION_START_DATE = ', &
	292	simulation_start_date(1:19)
	293	CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
	294	ELSE IF ( switch .EQ. restart_only ) THEN
	295	WRITE(wrf_err_message,*)fid,' input_wrf, restart_only: SIMULATION_START_DATE = ', &
	296	simulation_start_date(1:19)
	297	CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
	298	ENDIF
	299	ELSE
	300	CALL nl_get_start_year ( 1 , simulation_start_year )
	301	CALL nl_get_start_month ( 1 , simulation_start_month )
	302	CALL nl_get_start_day ( 1 , simulation_start_day )
	303	CALL nl_get_start_hour ( 1 , simulation_start_hour )
	304	CALL nl_get_start_minute ( 1 , simulation_start_minute )
	305	CALL nl_get_start_second ( 1 , simulation_start_second )
	306	CALL nl_set_simulation_start_year ( 1 , simulation_start_year )
	307	CALL nl_set_simulation_start_month ( 1 , simulation_start_month )
	308	CALL nl_set_simulation_start_day ( 1 , simulation_start_day )
	309	CALL nl_set_simulation_start_hour ( 1 , simulation_start_hour )
	310	CALL nl_set_simulation_start_minute ( 1 , simulation_start_minute )
	311	CALL nl_set_simulation_start_second ( 1 , simulation_start_second )
	312	IF ( reset_simulation_start ) THEN
	313	CALL wrf_message('input_wrf: forcing SIMULATION_START_DATE = head_grid start time')
	314	CALL wrf_message(' due to namelist variable reset_simulation_start')
	315	ELSE
	316	CALL wrf_message('input_wrf: SIMULATION_START_DATE not available in input')
	317	CALL wrf_message('will use head_grid start time from namelist')
	318	ENDIF
	319	ENDIF
	320	! Initialize derived time quantity in grid%xtime.
	321	! Note that this call is also made in setup_timekeeping().
	322	! Ugh, what a hack. Simplify all this later...
	323	CALL domain_clock_get( grid, minutesSinceSimulationStart=grid%xtime )
	324	! Note that it is NOT necessary to reset grid%julian here.
	325	WRITE(wrf_err_message,*) 'input_wrf: set xtime to ',grid%xtime
	326	CALL wrf_debug ( 100, TRIM(wrf_err_message) )
	327	ELSE IF ( switch .EQ. auxinput1_only ) then
	328	CALL wrf_get_dom_ti_char ( fid , 'SIMULATION_START_DATE' , first_date_input , ierr )
	329	WRITE(wrf_err_message,*)'metgrid input_wrf.F first_date_input = ',first_date_input
	330	CALL wrf_message(wrf_err_message)
	331	CALL nl_get_start_year ( 1 , first_date_start_year )
	332	CALL nl_get_start_month ( 1 , first_date_start_month )
	333	CALL nl_get_start_day ( 1 , first_date_start_day )
	334	CALL nl_get_start_hour ( 1 , first_date_start_hour )
	335	CALL nl_get_start_minute ( 1 , first_date_start_minute )
	336	CALL nl_get_start_second ( 1 , first_date_start_second )
	337	WRITE ( first_date_nml, fmt = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
	338	first_date_start_year, first_date_start_month, &
	339	first_date_start_day, first_date_start_hour, &
	340	first_date_start_minute, first_date_start_second
	341	WRITE (wrf_err_message,*) 'metgrid input_wrf.F first_date_nml = ',first_date_nml
	342	CALL wrf_message( TRIM(wrf_err_message ) )
	343	ENDIF
	344
	345	! Test to make sure that the input data is the right size. Do this for input from real/ideal into
	346	! WRF, and from the standard initialization into real.
	347
	348	IF ( ( switch .EQ. input_only ) .OR. &
	349	( switch .EQ. auxinput1_only ) ) THEN
	350	ierr = 0
	351	CALL wrf_get_dom_ti_integer ( fid , 'WEST-EAST_GRID_DIMENSION' , ide_compare , 1 , icnt , ierr3 )
	352	ierr = max( ierr, ierr3 )
	353	CALL wrf_get_dom_ti_integer ( fid , 'SOUTH-NORTH_GRID_DIMENSION' , jde_compare , 1 , icnt , ierr3 )
	354	ierr = max( ierr, ierr3 )
	355	CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMENSION' , kde_compare , 1 , icnt , ierr3 )
	356	ierr = max( ierr, ierr3 )
	357	IF ( ierr3 .NE. 0 ) CALL wrf_error_fatal( 'wrf_get_dom_ti_integer getting dimension information from dataset' )
	358
	359	#if (EM_CORE == 1)
	360
	361	IF ( ( switch .EQ. input_only ) .AND. ( config_flags%io_form_input .EQ. 2 ) ) THEN
	362
	363	! For backward compatibility. If we do not find the hypsometric_opt defined
	364	! in the input data, this is pre version 3.4. Most likely, the hypsometric_opt
	365	! was the default value, 1.
	366
	367	hypsometric_opt = -1
	368	CALL wrf_get_dom_ti_integer ( fid , 'HYPSOMETRIC_OPT' , hypsometric_opt , 1 , icnt , ierr )
	369	IF ( ( hypsometric_opt .NE. 1 ) .AND. ( hypsometric_opt .NE. 2 ) ) THEN
	370	grid%hypsometric_opt = 1
	371	config_flags%hypsometric_opt = 1
	372	DO loop = 1 , grid%max_dom
	373	CALL nl_set_hypsometric_opt ( loop , 1 )
	374	END DO
	375	WRITE(wrf_err_message,*)'Resetting the hypsometric_opt from default value of 2 to 1'
	376	CALL wrf_debug( 0 , wrf_err_message )
	377	END IF
	378	END IF
	379
	380	! Test to make sure that the grid distances are the right size.
	381
	382	CALL wrf_get_dom_ti_real ( fid , 'DX' , dx_compare , 1 , icnt , ierr )
	383	CALL wrf_get_dom_ti_real ( fid , 'DY' , dy_compare , 1 , icnt , ierr )
	384	IF ( ( ABS ( dx_compare - config_flags%dx ) .GT. 1.E-5 * dx_compare ) .OR. &
	385	( ABS ( dy_compare - config_flags%dy ) .GT. 1.E-5 * dy_compare ) ) THEN
	386	IF ( ( config_flags%polar ) .AND. ( config_flags%grid_id .EQ. 1 ) ) THEN
	387	WRITE(wrf_err_message,*)'input_wrf: DX and DY from input file expected to be wrong'
	388	CALL wrf_debug ( 1 , wrf_err_message )
	389	ELSE
	390	WRITE(wrf_err_message,*)'dx and dy from file ',dx_compare,dy_compare
	391	CALL wrf_message(wrf_err_message)
	392	WRITE(wrf_err_message,*)'dx and dy from namelist ',config_flags%dx,config_flags%dy
	393	CALL wrf_message(wrf_err_message)
	394	CALL wrf_error_fatal( 'DX and DY do not match comparing namelist to the input file' )
	395	END IF
	396	END IF
	397	#endif
	398	END IF
	399
	400	#if (EM_CORE == 1)
	401	IF ( ( switch .EQ. input_only ) .OR. ( switch .EQ. auxinput2_only ) .OR. ( switch .EQ. auxinput1_only ) ) THEN
	402	ierr = 0
	403	ierr3 = 0
	404	IF ( ( ( switch .EQ. input_only ) .AND. ( grid%id .GE. 2 ) ) .OR. ( switch .EQ. auxinput2_only ) ) THEN
	405	CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' , itmp , 1 , icnt , ierr3 )
	406	ELSE IF ( ( switch .EQ. auxinput1_only ) .AND. ( grid%id .GE. 2 ) ) THEN
	407	CALL wrf_get_dom_ti_integer ( fid , 'i_parent_start' , itmp , 1 , icnt , ierr3 )
	408	ELSE IF ( ( ( switch .EQ. auxinput1_only ) .OR. ( switch .EQ. input_only ) ) .AND. ( grid%id .EQ. 1 ) ) THEN
	409	itmp = config_flags%i_parent_start
	410	ierr3 = 0
	411	END IF
	412	ierr = max( ierr, ierr3 )
	413	IF ( itmp .NE. config_flags%i_parent_start ) THEN
	414	ierr = 1
	415	WRITE(wrf_err_message,*)'i_parent_start from namelist.input file = ',config_flags%i_parent_start
	416	CALL wrf_message(wrf_err_message)
	417	WRITE(wrf_err_message,*)'i_parent_start from gridded input file = ',itmp
	418	CALL wrf_message(wrf_err_message)
	419	END IF
	420	IF ( ( ( switch .EQ. input_only ) .AND. ( grid%id .GE. 2 ) ) .OR. ( switch .EQ. auxinput2_only ) ) THEN
	421	CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' , itmp , 1 , icnt , ierr3 )
	422	ELSE IF ( ( switch .EQ. auxinput1_only ) .AND. ( grid%id .GE. 2 ) ) THEN
	423	CALL wrf_get_dom_ti_integer ( fid , 'j_parent_start' , itmp , 1 , icnt , ierr3 )
	424	ELSE IF ( ( ( switch .EQ. auxinput1_only ) .OR. ( switch .EQ. input_only ) ) .AND. ( grid%id .EQ. 1 ) ) THEN
	425	itmp = config_flags%j_parent_start
	426	ierr3 = 0
	427	END IF
	428	ierr = max( ierr, ierr3 )
	429	IF ( itmp .NE. config_flags%j_parent_start ) THEN
	430	ierr = 1
	431	WRITE(wrf_err_message,*)'j_parent_start from namelist.input file = ',config_flags%j_parent_start
	432	CALL wrf_message(wrf_err_message)
	433	WRITE(wrf_err_message,*)'j_parent_start from gridded input file = ',itmp
	434	CALL wrf_message(wrf_err_message)
	435	END IF
	436	IF ( ierr .NE. 0 ) THEN
	437	CALL wrf_error_fatal( 'Nest start locations do not match: namelist.input vs gridded input file' )
	438	END IF
	439	END IF
	440	#endif
	441
	442	! do the check later (see check_if_dryrun below)
	443
	444	! We do not want the CEN_LAT LON values from the boundary file. For 1-way nests
	445	! with ndown, this ends up being the data from the previous coarse domain.
	446
	447	IF ( switch .NE. boundary_only ) THEN
	448	CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , config_flags%cen_lat , 1 , icnt , ierr )
	449	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',config_flags%cen_lat
	450	CALL wrf_debug ( 300 , wrf_err_message )
	451	CALL nl_set_cen_lat ( grid%id , config_flags%cen_lat )
	452
	453	CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , config_flags%cen_lon , 1 , icnt , ierr )
	454	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',config_flags%cen_lon
	455	CALL wrf_debug ( 300 , wrf_err_message )
	456	CALL nl_set_cen_lon ( grid%id , config_flags%cen_lon )
	457	ELSE
	458	CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , dum , 1 , icnt , ierr )
	459	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LAT returns ',dum
	460	CALL wrf_debug ( 300 , wrf_err_message )
	461
	462	CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , dum , 1 , icnt , ierr )
	463	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for CEN_LON returns ',dum
	464	CALL wrf_debug ( 300 , wrf_err_message )
	465	END IF
	466
	467	CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' , config_flags%truelat1 , 1 , icnt , ierr )
	468	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT1 returns ',config_flags%truelat1
	469	CALL wrf_debug ( 300 , wrf_err_message )
	470	CALL nl_set_truelat1 ( grid%id , config_flags%truelat1 )
	471
	472	CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' , config_flags%truelat2 , 1 , icnt , ierr )
	473	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for TRUELAT2 returns ',config_flags%truelat2
	474	CALL wrf_debug ( 300 , wrf_err_message )
	475	CALL nl_set_truelat2 ( grid%id , config_flags%truelat2 )
	476
	477	CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' , config_flags%moad_cen_lat , 1 , icnt , ierr )
	478	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for MOAD_CEN_LAT returns ',config_flags%moad_cen_lat
	479	CALL wrf_debug ( 300 , wrf_err_message )
	480	CALL nl_set_moad_cen_lat ( grid%id , config_flags%moad_cen_lat )
	481
	482	CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' , config_flags%stand_lon , 1 , icnt , ierr )
	483	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for STAND_LON returns ',config_flags%stand_lon
	484	CALL wrf_debug ( 300 , wrf_err_message )
	485	CALL nl_set_stand_lon ( grid%id , config_flags%stand_lon )
	486
	487	#if ( NMM_CORE != 1 )
	488
	489	CALL wrf_get_dom_ti_real ( fid , 'POLE_LAT' , config_flags%pole_lat , 1 , icnt , ierr )
	490	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for POLE_LAT returns ',config_flags%pole_lat
	491	CALL wrf_debug ( 300 , wrf_err_message )
	492	CALL nl_set_pole_lat ( grid%id , config_flags%pole_lat )
	493
	494	CALL wrf_get_dom_ti_real ( fid , 'POLE_LON' , config_flags%pole_lon , 1 , icnt , ierr )
	495	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for POLE_LON returns ',config_flags%pole_lon
	496	CALL wrf_debug ( 300 , wrf_err_message )
	497	CALL nl_set_pole_lon ( grid%id , config_flags%pole_lon )
	498
	499	! program_name is defined in module_domain and set in the main program for whatever application
	500	! is using subroutine input_wrf (that is, the subroutine you are looking at here). Data files
	501	! written by SI have P_TOP as a metadata item; the real program and wrf model have it as a
	502	! state variable. This test is to supress non-fatal but confusing messages from the model complaining
	503	! that P_TOP cannot be read from the metadata for this dataset. JM 20040905
	504	!
	505	! Note, P_TOP is not defined in the NMM core.
	506
	507	IF ( program_name(1:7) .EQ. "REAL_EM" ) THEN
	508	CALL wrf_get_dom_ti_real ( fid , 'P_TOP' , grid%p_top , 1 , icnt , ierr )
	509	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for P_TOP returns ',grid%p_top
	510	CALL wrf_debug ( 300 , wrf_err_message )
	511	ENDIF
	512	#endif
	513
	514	IF ( switch .NE. boundary_only ) THEN
	515	CALL wrf_get_dom_ti_real ( fid , 'GMT' , config_flags%gmt , 1 , icnt , ierr )
	516	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_real for GMT returns ',config_flags%gmt
	517	CALL wrf_debug ( 300 , wrf_err_message )
	518	CALL nl_set_gmt ( grid%id , config_flags%gmt )
	519
	520	CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , config_flags%julyr , 1 , icnt , ierr )
	521	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULYR returns ',config_flags%julyr
	522	CALL wrf_debug ( 300 , wrf_err_message )
	523	CALL nl_set_julyr ( grid%id , config_flags%julyr )
	524
	525	CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , config_flags%julday , 1 , icnt , ierr )
	526	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for JULDAY returns ',config_flags%julday
	527	CALL wrf_debug ( 300 , wrf_err_message )
	528	CALL nl_set_julday ( grid%id , config_flags%julday )
	529	ENDIF
	530
	531	CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , config_flags%map_proj , 1 , icnt , ierr )
	532	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for MAP_PROJ returns ',config_flags%map_proj
	533	CALL wrf_debug ( 300 , wrf_err_message )
	534	CALL nl_set_map_proj ( grid%id , config_flags%map_proj )
	535	grid%map_proj = config_flags%map_proj
	536
	537	CALL wrf_get_dom_ti_char ( fid , 'MMINLU', mminlu , ierr )
	538	IF ( ierr .NE. 0 ) THEN
	539	WRITE(wrf_err_message,*)'MMINLU error on input'
	540	mminlu = " "
	541	CALL wrf_debug ( 0 , wrf_err_message )
	542	ELSE IF ( ( ( mminlu(1:1) .GE. "A" ) .AND. ( mminlu(1:1) .LE. "Z" ) ) .OR. &
	543	( ( mminlu(1:1) .GE. "a" ) .AND. ( mminlu(1:1) .LE. "z" ) ) .OR. &
	544	( ( mminlu(1:1) .GE. "0" ) .AND. ( mminlu(1:1) .LE. "9" ) ) ) THEN
	545	! no-op, the mminlu field is probably OK
	546	ELSE IF ( mminlu(1:1) .EQ. " " ) THEN
	547	mminlu = " "
	548	ELSE
	549	mminlu = " "
	550	END IF
	551	call wrf_debug( 1 , "mminlu = '" // TRIM(mminlu) // "'")
	552	if (index(mminlu, char(0)) > 0) mminlu(index(mminlu, char(0)):) = " "
	553	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_char for MMINLU returns ' // TRIM(mminlu)
	554	CALL wrf_debug ( 300 , wrf_err_message )
	555	CALL nl_set_mminlu ( grid%id, mminlu )
	556
	557	! Test to make sure that the number of land categories is set correctly
	558	! The default is set to 24 somewhere, from the number of categories
	559	! in the traditional USGS dataset
	560
	561	IF ( ( switch .EQ. input_only ) .OR. &
	562	( switch .EQ. auxinput1_only ) .OR. &
	563	( switch .EQ. auxinput2_only ) ) THEN
	564	call wrf_get_dom_ti_integer(fid, "NUM_LAND_CAT", num_land_cat_compare, 1, icnt, ierr)
	565	if ( (ierr .NE. 0) .OR. ( num_land_cat_compare .LT. 1 ) .OR. ( num_land_cat_compare .GT. 1000 ) ) then
	566	IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
	567	call wrf_debug( 1 , "Must be old WPS data, assuming 20 levels for NUM_LAND_CAT")
	568	num_land_cat_compare = 20
	569	ELSE
	570	call wrf_debug( 1 , "Must be old WPS data, assuming 24 levels for NUM_LAND_CAT")
	571	num_land_cat_compare = 24
	572	END IF
	573	endif
	574	if ( config_flags%num_land_cat /= num_land_cat_compare ) then
	575	call wrf_message("----------------- ERROR -------------------")
	576	WRITE(wrf_err_message,'("namelist : NUM_LAND_CAT = ",I10)') config_flags%num_land_cat
	577	call wrf_message(wrf_err_message)
	578	WRITE(wrf_err_message,'("input files : NUM_LAND_CAT = ",I10, " (from geogrid selections).")') num_land_cat_compare
	579	call wrf_message(wrf_err_message)
	580	call wrf_error_fatal("Mismatch between namelist and wrf input files for dimension NUM_LAND_CAT")
	581	endif
	582	ENDIF
	583
	584	! Test here to check that config_flags%num_metgrid_soil_levels in namelist
	585	! is equal to what is in the global attributes of the met_em files. Note that
	586	! if this is not the first time period, we don't really care about soil data.
	587
	588	IF ( ( switch .EQ. auxinput1_only ) .AND. &
	589	( first_date_nml .EQ. first_date_input ) ) THEN
	590	CALL wrf_get_dom_ti_integer ( fid, 'NUM_METGRID_SOIL_LEVELS', itmp, 1, icnt, ierr )
	591
	592	IF ( ierr .EQ. 0 ) THEN
	593
	594	#if (EM_CORE == 1)
	595	IF ( itmp .EQ. 1 ) THEN
	596	call wrf_error_fatal("NUM_METGRID_SOIL_LEVELS must be greater than 1")
	597	END IF
	598	#endif
	599	WRITE(wrf_err_message,*)'input_wrf: global attribute NUM_METGRID_SOIL_LEVELS returns ', itmp
	600	CALL wrf_debug ( 300 , wrf_err_message )
	601	IF ( config_flags%num_metgrid_soil_levels /= itmp ) THEN
	602	call wrf_message("----------------- ERROR -------------------")
	603	WRITE(wrf_err_message,'("namelist : num_metgrid_soil_levels = ",I10)') config_flags%num_metgrid_soil_levels
	604	call wrf_message(wrf_err_message)
	605	#if (EM_CORE == 1)
	606	WRITE(wrf_err_message,'("input files : NUM_METGRID_SOIL_LEVELS = ",I10, " (from met_em files).")') itmp
	607	#else
	608	WRITE(wrf_err_message,'("input files : NUM_METGRID_SOIL_LEVELS = ",I10, " (from met_nmm files).")') itmp
	609	#endif
	610	call wrf_message(wrf_err_message)
	611	call wrf_error_fatal("Mismatch between namelist and global attribute NUM_METGRID_SOIL_LEVELS")
	612	END IF
	613	END IF
	614	END IF
	615
	616	#if 0
	617	#if ( WRF_CHEM == 1 )
	618	! Dust erosion static data.
	619
	620	CALL wrf_get_dom_ti_integer ( fid, 'EROSION_DIM', itmp, 1, icnt, ierr )
	621
	622	IF ( ierr .EQ. 0 ) THEN
	623	WRITE(wrf_err_message,*)'input_wrf: global attribute EROSION_DIM returns ', itmp
	624	CALL wrf_debug ( 300 , wrf_err_message )
	625	IF ( config_flags%erosion_dim /= itmp ) THEN
	626	call wrf_message("----------------- ERROR -------------------")
	627	WRITE(wrf_err_message,'("namelist : erosion_dim = ",I10)') config_flags%erosion_dim
	628	call wrf_message(wrf_err_message)
	629	WRITE(wrf_err_message,'("input files : EROSION_DIM = ",I10, " (from met_em files).")') itmp
	630	call wrf_message(wrf_err_message)
	631	call wrf_error_fatal("Mismatch between namelist and global attribute EROSION_DIM")
	632	END IF
	633	END IF
	634	#endif
	635	#endif
	636
	637	! Test here to check that config_flags%sf_surface_physics in namelist
	638	! is equal to what is in the global attributes of the wrfinput files
	639
	640	IF ( switch .EQ. input_only ) THEN
	641	CALL wrf_get_dom_ti_integer ( fid, 'SF_SURFACE_PHYSICS', itmp, 1, icnt, ierr )
	642	IF ( ierr .EQ. 0 ) THEN
	643	WRITE(wrf_err_message,*)'input_wrf: global attribute SF_SURFACE_PHYSICS returns ', itmp
	644	CALL wrf_debug ( 300 , wrf_err_message )
	645	IF ( config_flags%sf_surface_physics /= itmp ) THEN
	646	IF ( ( config_flags%sf_surface_physics == LSMSCHEME ) .and. ( itmp == NOAHMPSCHEME ) ) then
	647	! All is well. Noah-MP and Noah have compatible wrfinput files.
	648	ELSE IF ( ( config_flags%sf_surface_physics == NOAHMPSCHEME ) .and. ( itmp == LSMSCHEME ) ) then
	649	! All is well. Noah-MP and Noah have compatible wrfinput files.
	650	ELSE
	651	call wrf_message("----------------- ERROR -------------------")
	652	WRITE(wrf_err_message,'("namelist : sf_surface_physics = ",I10)') config_flags%sf_surface_physics
	653	call wrf_message(wrf_err_message)
	654	WRITE(wrf_err_message,'("input files : SF_SURFACE_PHYSICS = ",I10, " (from wrfinput files).")') itmp
	655	call wrf_message(wrf_err_message)
	656	call wrf_error_fatal("Mismatch between namelist and global attribute SF_SURFACE_PHYSICS")
	657	END IF
	658	END IF
	659	END IF
	660	END IF
	661
	662
	663	CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , config_flags%iswater , 1 , icnt , ierr )
	664	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISWATER returns ',config_flags%iswater
	665	CALL wrf_debug ( 300 , wrf_err_message )
	666	IF ( ierr .NE. 0 ) THEN
	667	IF (mminlu == 'UMD') THEN
	668	config_flags%iswater = 14
	669	ELSE IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
	670	config_flags%iswater = 17
	671	ELSE
	672	config_flags%iswater = 16
	673	ENDIF
	674	ENDIF
	675	CALL nl_set_iswater ( grid%id , config_flags%iswater )
	676	grid%iswater = config_flags%iswater
	677
	678	CALL wrf_get_dom_ti_integer ( fid , 'ISLAKE' , config_flags%islake , 1 , icnt , ierr )
	679	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISLAKE returns ',config_flags%islake
	680	CALL wrf_debug ( 300 , wrf_err_message )
	681	IF ( ierr .NE. 0 ) THEN
	682	config_flags%islake = -1
	683	ENDIF
	684	CALL nl_set_islake ( grid%id , config_flags%islake )
	685	grid%islake = config_flags%islake
	686
	687	CALL wrf_get_dom_ti_integer ( fid , 'ISICE' , config_flags%isice , 1 , icnt , ierr )
	688	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISICE returns ',config_flags%isice
	689	CALL wrf_debug ( 300 , wrf_err_message )
	690	IF ( ierr .NE. 0 ) THEN
	691	IF (mminlu == 'UMD') THEN
	692	config_flags%isice = 14
	693	ELSE IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
	694	config_flags%isice = 15
	695	ELSE
	696	config_flags%isice = 24
	697	ENDIF
	698	ENDIF
	699	CALL nl_set_isice ( grid%id , config_flags%isice )
	700	grid%isice = config_flags%isice
	701
	702	CALL wrf_get_dom_ti_integer ( fid , 'ISURBAN' , config_flags%isurban , 1 , icnt , ierr )
	703	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISURBAN returns ',config_flags%isurban
	704	CALL wrf_debug ( 300 , wrf_err_message )
	705	IF ( ierr .NE. 0 ) THEN
	706	IF (mminlu == 'UMD') THEN
	707	config_flags%isurban = 13
	708	ELSE IF (mminlu == 'MODIFIED_IGBP_MODIS_NOAH') THEN
	709	config_flags%isurban = 13
	710	ELSE
	711	config_flags%isurban = 1
	712	ENDIF
	713	ENDIF
	714	CALL nl_set_isurban ( grid%id , config_flags%isurban )
	715	grid%isurban = config_flags%isurban
	716
	717	CALL wrf_get_dom_ti_integer ( fid , 'ISOILWATER' , config_flags%isoilwater , 1 , icnt , ierr )
	718	WRITE(wrf_err_message,*)'input_wrf: wrf_get_dom_ti_integer for ISOILWATER returns ',config_flags%isoilwater
	719	CALL wrf_debug ( 300 , wrf_err_message )
	720	IF ( ierr .NE. 0 ) THEN
	721	config_flags%isoilwater = 14
	722	ENDIF
	723	CALL nl_set_isoilwater ( grid%id , config_flags%isoilwater )
	724	grid%isoilwater = config_flags%isoilwater
	725
	726	#ifdef MOVE_NESTS
	727	! Added these fields for restarting of moving nests, JM
	728	! DANGER and TODO
	729	! It is very important that these be set correctly if they are set at all in here.
	730	! Garbage values will produce unpredictable results, possibly segfaults, in the nesting
	731	! code. Need some integrity checking here or elsewhere in the code to at least check to
	732	! make sure that the istart and jstart values make sense with respect to the nest dimensions
	733	! and the position in the parent domain.
	734	CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' , itmp , 1 , icnt, ierr )
	735	IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
	736	config_flags%i_parent_start = itmp
	737	CALL nl_set_i_parent_start ( grid%id , config_flags%i_parent_start )
	738	ENDIF
	739	CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' , itmp , 1 , icnt, ierr )
	740	IF ( ierr .EQ. 0 .AND. switch .EQ. restart_only ) THEN
	741	config_flags%j_parent_start = itmp
	742	CALL nl_set_j_parent_start ( grid%id , config_flags%j_parent_start )
	743	ENDIF
	744	#endif
	745
	746	#if (EM_CORE == 1)
	747
	748	!KLUDGE - is there a more elegant way to determine "old si" input
	749	IF ( ( switch .EQ. input_only ) .OR. &
	750	( ( switch .EQ. auxinput1_only ) .AND. &
	751	( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) ) THEN
	752
	753	! Test to make sure that the input data is the right size.
	754
	755	IF ( ( ide .NE. ide_compare ) .OR. &
	756	( kde .NE. kde_compare ) .OR. &
	757	( jde .NE. jde_compare ) ) THEN
	758	WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: namelist ide,jde,kde=',ide,jde,kde,&
	759	'; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
	760	CALL wrf_error_fatal( wrf_err_message )
	761	ENDIF
	762
	763	ELSE IF ( switch .EQ. auxinput1_only ) THEN
	764
	765	! Test to make sure that the input data is the right size.
	766
	767	IF ( ( ide .NE. ide_compare ) .OR. &
	768	( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
	769	( jde .NE. jde_compare ) ) THEN
	770	WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: ',&
	771	'namelist ide,jde,num_metgrid_levels=',ide,jde,config_flags%num_metgrid_levels,&
	772	'; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
	773	CALL wrf_error_fatal( wrf_err_message )
	774	ENDIF
	775	ENDIF
	776
	777	#endif
	778
	779	#if (NMM_CORE == 1)
	780
	781	IF ( ( switch .EQ. auxinput1_only ) .AND. &
	782	( config_flags%auxinput1_inname(1:8) .EQ. 'wrf_real' ) ) THEN
	783
	784	CALL wrf_get_dom_ti_integer ( fid , 'BOTTOM-TOP_GRID_DIMSNSION' , kde_compare , 1 , icnt , ierr3 )
	785
	786	! Test to make sure that the input data is the right size.
	787
	788	IF ( ( ide-1 .NE. ide_compare ) .OR. &
	789	( kde .NE. kde_compare ) .OR. &
	790	( jde-1 .NE. jde_compare ) .AND. ierr3 .EQ. 0 ) THEN
	791	WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: namelist ide-1,jde-1,kde=',ide-1,jde-1,kde,&
	792	'; input data ide,jde,kde=',ide_compare , jde_compare , kde_compare
	793	CALL wrf_debug( 100, wrf_err_message )
	794	ENDIF
	795
	796	ELSEIF ( switch .EQ. auxinput1_only ) THEN ! assume just WPS in this branch
	797	IF ( ( ide-1 .NE. ide_compare ) .OR. &
	798	( config_flags%num_metgrid_levels .NE. kde_compare ) .OR. &
	799	( jde-1 .NE. jde_compare ) .AND. ierr3 .EQ. 0 ) THEN
	800	WRITE(wrf_err_message,*)'input_wrf.F: SIZE MISMATCH: ',&
	801	'namelist ide-1,jde-1,num_metgrid_levels=',ide-1,jde-1,config_flags%num_metgrid_levels,&
	802	'; input data ide,jde,num_metgrid_levels=',ide_compare , jde_compare , kde_compare
	803	IF (ide-1 .eq. ide_compare .AND. jde-1 .EQ. jde_compare) THEN
	804	CALL wrf_message(wrf_err_message)
	805	CALL wrf_error_fatal( "appears that the vertical dimension is wrong - quitting" )
	806	ELSE
	807	CALL wrf_message(wrf_err_message)
	808	CALL wrf_error_fatal( "appears that I or J dimensions are wrong - quitting" )
	809	ENDIF
	810	ENDIF
	811	ENDIF
	812
	813	#endif
	814
	815	#if (DA_CORE == 1)
	816	! Test here to check that config_flags%hypsometric_opt in namelist
	817	! is equal to what is in the global attributes of the wrfinput files
	818
	819	IF ( switch .EQ. input_only ) THEN
	820	CALL wrf_get_dom_ti_integer ( fid, 'HYPSOMETRIC_OPT', itmp, 1, icnt, ierr )
	821	IF ( ierr .EQ. 0 ) THEN
	822	WRITE(wrf_err_message,*)'input_wrf: global attribute HYPSOMETRIC_OPT returns ', itmp
	823	CALL wrf_debug ( 300 , wrf_err_message )
	824	IF ( config_flags%hypsometric_opt /= itmp ) THEN
	825	call wrf_message("----------------- WARNING -------------------")
	826	WRITE(wrf_err_message,'("namelist : hypsometric_opt = ",I10)') config_flags%hypsometric_opt
	827	call wrf_message(wrf_err_message)
	828	WRITE(wrf_err_message,'("input files : HYPSOMETRIC_OPT = ",I10, " (from wrfinput files).")') itmp
	829	call wrf_message(wrf_err_message)
	830	call wrf_error_fatal("Mismatch between namelist and global attribute HYPSOMETRIC_OPT")
	831	END IF
	832	END IF
	833	END IF
	834
	835	#endif
	836
	837	ENDIF check_if_dryrun
	838
	839	!
	840	! This call to wrf_get_next_time will position the dataset over the next time-frame
	841	! in the file and return the current_date, which is used as an argument to the
	842	! read_field routines in the blocks of code included below. Note that we read the
	843	! next time after all the meta data has been read. This is only important for the
	844	! WRF internal I/O format because it is order-dependent. Other formats shouldn't care
	845	! about this.
	846	!
	847
	848	3003 continue
	849
	850	CALL wrf_get_next_time(fid, current_date , ierr)
	851	WRITE(wrf_err_message,*)fid,' input_wrf: wrf_get_next_time current_date: ',current_date(1:19),' Status = ',ierr
	852	CALL wrf_debug ( 300 , TRIM(wrf_err_message ) )
	853	IF ( ierr .NE. 0 .AND. ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ ) THEN
	854	CALL wrf_message ( TRIM(wrf_err_message ) )
	855	IF ( switch .EQ. boundary_only ) THEN
	856	WRITE(wrf_err_message,*) ' ... May have run out of valid boundary conditions in file ',TRIM(fname)
	857	CALL wrf_error_fatal( TRIM(wrf_err_message) )
	858	ELSE
	859	#if ( NMM_CORE != 1 )
	860	WRITE(wrf_err_message,*) '... Could not find matching time in input file ',TRIM(fname)
	861	CALL wrf_error_fatal( TRIM(wrf_err_message) )
	862	#endif
	863	ENDIF
	864	ELSE IF ( ierr .NE. WRF_WARN_NOTSUPPORTED .AND. ierr .NE. WRF_WARN_DRYRUN_READ) THEN
	865	!
	866	! check input time against domain time (which will be start time at beginning, see share/set_timekeeping.F)
	867	! JM 20040511
	868	!
	869	SELECT CASE ( switch )
	870	CASE ( input_only, auxinput1_only, auxinput2_only, &
	871	auxinput3_only, auxinput4_only, auxinput5_only, &
	872	auxinput6_only, auxinput7_only, auxinput8_only, &
	873	auxinput9_only, auxinput10_only )
	874	#if ( WRF_CHEM == 1 )
	875	IF( (config_flags%io_style_emissions .eq. 1) .and. &
	876	((switch.eq.auxinput5_only) .or. (switch.eq.auxinput6_only) .or. &
	877	(switch.eq.auxinput7_only) .or. (switch.eq.auxinput8_only)) ) then
	878	CALL wrf_message( "WARNING Time in input file not being checked WARNING" )
	879	ELSE
	880	#endif
	881	CALL wrf_atotime( current_date(1:19), time )
	882	CALL domain_clock_get( grid, current_time=currtime, &
	883	current_timestr=currtimestr )
	884	#if (DA_CORE != 1)
	885	! Don't perform the check for WRFVAR, as we're not passing the right dates
	886	! around
	887	CALL domain_clockprint(150, grid, &
	888	'DEBUG input_wrf(): get CurrTime from clock,')
	889	IF ( time .NE. currtime ) THEN
	890	WRITE( wrf_err_message , * )'Time in file: ',trim( current_date(1:19) )
	891	CALL wrf_message ( trim(wrf_err_message) )
	892	WRITE( wrf_err_message , * )'Time on domain: ',trim( currtimestr )
	893	CALL wrf_message ( trim(wrf_err_message) )
	894	CALL wrf_message( "WARNING Time in input file not equal to time on domain WARNING" )
	895	WRITE(wrf_err_message,) "WARNING* Trying next time in file ",TRIM(fname)," ..."
	896	CALL wrf_message( TRIM(wrf_err_message) )
	897	GOTO 3003
	898	ENDIF
	899	#endif
	900	#if ( WRF_CHEM == 1 )
	901	ENDIF
	902	#endif
	903	CASE DEFAULT
	904	END SELECT
	905	ENDIF
	906
	907	! set the lbc time interval fields in the domain data structure
	908	! these time values are checked as stopping condition for the while loop in
	909	! latbound_in() defined in share/medation_integrate.F, which is used to
	910	! iterate forward to the correct interval in the input LBC file
	911	!
	912	IF ( switch .EQ. boundary_only ) THEN
	913	IF ( config_flags%restart ) THEN
	914	! get WRF time of current_date position in boundary file
	915	CALL wrf_atotime( current_date(1:19), time )
	916	! jump straight to the restart time
	917	CALL domain_clock_get( grid, current_time=currentTime, &
	918	current_timestr=currtimestr )
	919	write(wrf_err_message, '(4a)') "WRF restart, LBC starts at ", &
	920	& trim(current_date), " and restart starts at ", trim(currtimestr)
	921	CALL wrf_debug( 0 , wrf_err_message )
	922
	923	! While the lateral BC time is less than the restart time, advance forward to the next LBC time.
	924
	925	DO WHILE (time .lt. currentTime)
	926	CALL wrf_get_next_time(fid, current_date , ierr)
	927	CALL wrf_atotime(current_date(1:19), time)
	928	WRITE(wrf_err_message,*) 'Advancing LBC file: wrf_get_next_time current_date: ',&
	929	& current_date(1:19),' Status = ',ierr
	930	IF ( ierr .EQ. 0 ) THEN
	931	CALL wrf_debug ( 0 , TRIM(wrf_err_message ) )
	932	ELSE
	933	CALL wrf_error_fatal ( 'Cannot find a valid time to start the LBC during this restart' )
	934	END IF
	935	END DO
	936
	937	! Now the LBC time either matches or is beyond the restart time. If it matches, we are at the
	938	! right time. If we have gone too far, then back up one time period, and we are good to go.
	939
	940	IF ( time .eq. currentTime ) THEN
	941	CALL wrf_debug ( 0 , 'Found correct time, LBC matches the restart interval.' )
	942	ELSE IF ( time .gt. currentTime ) THEN
	943	CALL wrf_debug ( 0 , 'Went one LBC interval too far, backing up for restart.' )
	944	CALL wrf_get_previous_time(fid, current_date , ierr)
	945	IF ( ierr .EQ. 0 ) THEN
	946	CALL wrf_atotime(current_date(1:19), time)
	947	WRITE(wrf_err_message,*) 'LBC: wrf_get_prev_time current_date: ',&
	948	& current_date(1:19),' Status = ',ierr
	949	CALL wrf_debug ( 0 , TRIM(wrf_err_message ) )
	950	CALL wrf_debug ( 0 , 'LBC is now correctly positioned for requested restart time' )
	951	ELSE
	952	CALL wrf_error_fatal ( 'Problems backing up in the LBC file to find startig location for restart' )
	953	END IF
	954	END IF
	955
	956	CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' , current_date(1:19), this_datestr , ierr )
	957	CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
	958	CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' , current_date(1:19), next_datestr , ierr )
	959	CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
	960
	961	ELSE IF ( .NOT. config_flags%restart ) THEN
	962	CALL domain_clock_get( grid, current_time=currentTime )
	963	CALL wrf_get_dom_td_char ( fid , 'THISBDYTIME' , current_date(1:19), this_datestr , ierr )
	964	CALL wrf_atotime( this_datestr(1:19), grid%this_bdy_time )
	965	CALL wrf_get_dom_td_char ( fid , 'NEXTBDYTIME' , current_date(1:19), next_datestr , ierr )
	966	CALL wrf_atotime( next_datestr(1:19), grid%next_bdy_time )
	967	END IF
	968	#if (DA_CORE != 1)
	969	IF( currentTime .GE. grid%next_bdy_time ) THEN
	970	IF ( wrf_dm_on_monitor() ) THEN
	971	write(a_message,*) 'THIS TIME ',this_datestr(1:19),'NEXT TIME ',next_datestr(1:19)
	972	CALL wrf_message ( a_message )
	973	END IF
	974	RETURN
	975	ENDIF
	976	#endif
	977	ENDIF
	978
	979	#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
	980	! Vertical interpolation space is required if specified by user.
	981
	982	n_ref_m = config_flags%vert_refine_fact
	983	#else
	984	! Default value indicating no vertical interpolation required.
	985
	986	n_ref_m = 0
	987	#endif
	988
	989	IF ( (first_input .LE. switch .AND. switch .LE. last_input) .OR. &
	990	(first_history .LE. switch .AND. switch .LE. last_history) .OR. &
	991	switch .EQ. restart_only ) THEN
	992	newswitch = switch
	993	p => grid%head_statevars%next
	994	DO WHILE ( ASSOCIATED( p ) )
	995	IF ( p%ProcOrient .NE. 'X' .AND. p%ProcOrient .NE. 'Y' ) THEN ! no I/O for xposed variables
	996	IF ( p%Ndim .EQ. 0 ) THEN
	997	IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
	998	IF ( in_use_for_config(grid%id,TRIM(p%VarName)) ) THEN
	999	IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
	1000	dname = p%DataName
	1001	IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
	1002	IF ( p%Type .EQ. 'r' ) THEN
	1003	CALL wrf_ext_read_field ( &
	1004	fid , & ! DataHandle
	1005	current_date(1:19) , & ! DateStr
	1006	TRIM(dname) , & ! Data Name
	1007	p%rfield_0d , & ! Field
	1008	WRF_FLOAT , & ! FieldType
	1009	grid%communicator , & ! Comm
	1010	grid%iocommunicator , & ! Comm
	1011	grid%domdesc , & ! Comm
	1012	grid%bdy_mask , & ! bdy_mask
	1013	'0' , & ! MemoryOrder
	1014	'' , & ! Stagger
	1015	__FILE__ // ' reading 0d real ' // TRIM(p%VarName) , & ! Debug message
	1016	1 , 1 , 1 , 1 , 1 , 1 , &
	1017	1 , 1 , 1 , 1 , 1 , 1 , &
	1018	1 , 1 , 1 , 1 , 1 , 1 , &
	1019	ierr )
	1020	ELSE IF ( p%Type .EQ. 'd' ) THEN
	1021	CALL wrf_ext_read_field ( &
	1022	fid , & ! DataHandle
	1023	current_date(1:19) , & ! DateStr
	1024	TRIM(dname) , & ! Data Name
	1025	p%dfield_0d , & ! Field
	1026	WRF_DOUBLE , & ! FieldType
	1027	grid%communicator , & ! Comm
	1028	grid%iocommunicator , & ! Comm
	1029	grid%domdesc , & ! Comm
	1030	grid%bdy_mask , & ! bdy_mask
	1031	'0' , & ! MemoryOrder
	1032	'' , & ! Stagger
	1033	__FILE__ // ' reading 0d double ' // TRIM(p%VarName) , & ! Debug message
	1034	1 , 1 , 1 , 1 , 1 , 1 , &
	1035	1 , 1 , 1 , 1 , 1 , 1 , &
	1036	1 , 1 , 1 , 1 , 1 , 1 , &
	1037	ierr )
	1038	ELSE IF ( p%Type .EQ. 'i' ) THEN
	1039	CALL wrf_ext_read_field ( &
	1040	fid , & ! DataHandle
	1041	current_date(1:19) , & ! DateStr
	1042	TRIM(dname) , & ! Data Name
	1043	p%ifield_0d , & ! Field
	1044	WRF_INTEGER , & ! FieldType
	1045	grid%communicator , & ! Comm
	1046	grid%iocommunicator , & ! Comm
	1047	grid%domdesc , & ! Comm
	1048	grid%bdy_mask , & ! bdy_mask
	1049	'0' , & ! MemoryOrder
	1050	'' , & ! Stagger
	1051	__FILE__ // ' reading 0d integer ' // TRIM(p%VarName) , & ! Debug message
	1052	1 , 1 , 1 , 1 , 1 , 1 , &
	1053	1 , 1 , 1 , 1 , 1 , 1 , &
	1054	1 , 1 , 1 , 1 , 1 , 1 , &
	1055	ierr )
	1056	ELSE IF ( p%Type .EQ. 'l' ) THEN
	1057	CALL wrf_ext_read_field ( &
	1058	fid , & ! DataHandle
	1059	current_date(1:19) , & ! DateStr
	1060	TRIM(dname) , & ! Data Name
	1061	p%lfield_0d , & ! Field
	1062	WRF_LOGICAL , & ! FieldType
	1063	grid%communicator , & ! Comm
	1064	grid%iocommunicator , & ! Comm
	1065	grid%domdesc , & ! Comm
	1066	grid%bdy_mask , & ! bdy_mask
	1067	'0' , & ! MemoryOrder
	1068	'' , & ! Stagger
	1069	__FILE__ // ' reading 0d logical ' // TRIM(p%VarName) , & ! Debug message
	1070	1 , 1 , 1 , 1 , 1 , 1 , &
	1071	1 , 1 , 1 , 1 , 1 , 1 , &
	1072	1 , 1 , 1 , 1 , 1 , 1 , &
	1073	ierr )
	1074	ENDIF
	1075	ENDIF
	1076	ENDIF
	1077	ENDIF
	1078	ELSE IF ( p%Ndim .EQ. 1 ) THEN
	1079	IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
	1080	IF ( in_use_for_config(grid%id,TRIM(p%VarName)) ) THEN
	1081	IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
	1082	dname = p%DataName
	1083	IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
	1084	memord = p%MemoryOrder
	1085
	1086	i_inter = 0
	1087	#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
	1088	! Vertical interpolation space is required if specified by user.
	1089
	1090	if( TRIM(p%dimname1).EQ.'bottom_top'.OR.TRIM(p%dimname1).EQ.'bottom_top_stag') i_inter = 1
	1091	#endif
	1092
	1093	IF ( p%Type .EQ. 'r' ) THEN
	1094	IF( (i_inter.eq.1.and.n_ref_m.ge.2).and.(switch.eq.history_only) ) THEN
	1095	em1_c = (p%em1 - 1)/n_ref_m +1
	1096	ed1_c = em1_c
	1097	ep1_c = em1_c
	1098	if (TRIM(p%dimname1).EQ.'bottom_top') then
	1099	ed1_c = em1_c-1
	1100	ep1_c = em1_c-1
	1101	endif
	1102	allocate (f_vint_1d(em1_c))
	1103
	1104	CALL wrf_ext_read_field ( &
	1105	fid , & ! DataHandle
	1106	current_date(1:19) , & ! DateStr
	1107	TRIM(dname) , & ! Data Name
	1108	f_vint_1d , & ! Field
	1109	WRF_FLOAT , & ! FieldType
	1110	grid%communicator , & ! Comm
	1111	grid%iocommunicator , & ! Comm
	1112	grid%domdesc , & ! Comm
	1113	grid%bdy_mask , & ! bdy_mask
	1114	TRIM(memord) , & ! MemoryOrder
	1115	p%Stagger , & ! Stagger
	1116	__FILE__ // ' reading 1d real ' // TRIM(p%VarName) , & ! Debug message
	1117	p%sd1 , ed1_c , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1118	p%sm1 , em1_c , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1119	p%sp1 , ep1_c , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1120	ierr )
	1121
	1122	do k=1,ed1_c
	1123	p%rfield_1d(k) = f_vint_1d(k)
	1124	enddo
	1125	deallocate (f_vint_1d)
	1126
	1127	ELSE
	1128	CALL wrf_ext_read_field ( &
	1129	fid , & ! DataHandle
	1130	current_date(1:19) , & ! DateStr
	1131	TRIM(dname) , & ! Data Name
	1132	p%rfield_1d , & ! Field
	1133	WRF_FLOAT , & ! FieldType
	1134	grid%communicator , & ! Comm
	1135	grid%iocommunicator , & ! Comm
	1136	grid%domdesc , & ! Comm
	1137	grid%bdy_mask , & ! bdy_mask
	1138	TRIM(memord) , & ! MemoryOrder
	1139	p%Stagger , & ! Stagger
	1140	__FILE__ // ' reading 1d real ' // TRIM(p%VarName) , & ! Debug message
	1141	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1142	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1143	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1144	ierr )
	1145	END IF
	1146	ELSE IF ( p%Type .EQ. 'd' ) THEN
	1147	CALL wrf_ext_read_field ( &
	1148	fid , & ! DataHandle
	1149	current_date(1:19) , & ! DateStr
	1150	TRIM(dname) , & ! Data Name
	1151	p%dfield_1d , & ! Field
	1152	WRF_DOUBLE , & ! FieldType
	1153	grid%communicator , & ! Comm
	1154	grid%iocommunicator , & ! Comm
	1155	grid%domdesc , & ! Comm
	1156	grid%bdy_mask , & ! bdy_mask
	1157	TRIM(memord) , & ! MemoryOrder
	1158	TRIM(p%Stagger) , & ! Stagger
	1159	__FILE__ // ' reading 1d double ' // TRIM(p%VarName) , & ! Debug message
	1160	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1161	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1162	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1163	ierr )
	1164	ELSE IF ( p%Type .EQ. 'i' ) THEN
	1165	CALL wrf_ext_read_field ( &
	1166	fid , & ! DataHandle
	1167	current_date(1:19) , & ! DateStr
	1168	TRIM(dname) , & ! Data Name
	1169	p%ifield_1d , & ! Field
	1170	WRF_INTEGER , & ! FieldType
	1171	grid%communicator , & ! Comm
	1172	grid%iocommunicator , & ! Comm
	1173	grid%domdesc , & ! Comm
	1174	grid%bdy_mask , & ! bdy_mask
	1175	TRIM(memord) , & ! MemoryOrder
	1176	TRIM(p%Stagger) , & ! Stagger
	1177	__FILE__ // ' reading 1d integer ' // TRIM(p%VarName) , & ! Debug message
	1178	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1179	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1180	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1181	ierr )
	1182	ELSE IF ( p%Type .EQ. 'l' ) THEN
	1183	CALL wrf_ext_read_field ( &
	1184	fid , & ! DataHandle
	1185	current_date(1:19) , & ! DateStr
	1186	TRIM(dname) , & ! Data Name
	1187	p%lfield_1d , & ! Field
	1188	WRF_LOGICAL , & ! FieldType
	1189	grid%communicator , & ! Comm
	1190	grid%iocommunicator , & ! Comm
	1191	grid%domdesc , & ! Comm
	1192	grid%bdy_mask , & ! bdy_mask
	1193	TRIM(memord) , & ! MemoryOrder
	1194	TRIM(p%Stagger) , & ! Stagger
	1195	__FILE__ // ' reading 1d logical ' // TRIM(p%VarName) , & ! Debug message
	1196	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1197	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1198	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1199	ierr )
	1200	ENDIF
	1201	ENDIF
	1202	ENDIF
	1203	ENDIF
	1204	ELSE IF ( p%Ndim .EQ. 2 ) THEN
	1205	IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
	1206	IF ( in_use_for_config(grid%id,TRIM(p%VarName)) .AND. &
	1207	( .NOT. p%subgrid_x .OR. (p%subgrid_x .AND. grid%sr_x .GT. 0) ) .AND. &
	1208	( .NOT. p%subgrid_y .OR. (p%subgrid_y .AND. grid%sr_y .GT. 0) ) &
	1209	) THEN
	1210	IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
	1211	dname = p%DataName
	1212	IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
	1213	memord = p%MemoryOrder
	1214	IF ( p%Type .EQ. 'r' ) THEN
	1215	CALL wrf_ext_read_field ( &
	1216	fid , & ! DataHandle
	1217	current_date(1:19) , & ! DateStr
	1218	TRIM(dname) , & ! Data Name
	1219	p%rfield_2d , & ! Field
	1220	WRF_FLOAT , & ! FieldType
	1221	grid%communicator , & ! Comm
	1222	grid%iocommunicator , & ! Comm
	1223	grid%domdesc , & ! Comm
	1224	grid%bdy_mask , & ! bdy_mask
	1225	TRIM(memord) , & ! MemoryOrder
	1226	TRIM(p%Stagger) , & ! Stagger
	1227	__FILE__ // ' reading 2d real ' // TRIM(p%VarName) , & ! Debug message
	1228	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1229	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1230	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1231	ierr )
	1232	ELSE IF ( p%Type .EQ. 'd' ) THEN
	1233	CALL wrf_ext_read_field ( &
	1234	fid , & ! DataHandle
	1235	current_date(1:19) , & ! DateStr
	1236	TRIM(dname) , & ! Data Name
	1237	p%dfield_2d , & ! Field
	1238	WRF_DOUBLE , & ! FieldType
	1239	grid%communicator , & ! Comm
	1240	grid%iocommunicator , & ! Comm
	1241	grid%domdesc , & ! Comm
	1242	grid%bdy_mask , & ! bdy_mask
	1243	TRIM(memord) , & ! MemoryOrder
	1244	TRIM(p%Stagger) , & ! Stagger
	1245	__FILE__ // ' reading 2d double ' // TRIM(p%VarName) , & ! Debug message
	1246	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1247	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1248	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1249	ierr )
	1250	ELSE IF ( p%Type .EQ. 'i' ) THEN
	1251	CALL wrf_ext_read_field ( &
	1252	fid , & ! DataHandle
	1253	current_date(1:19) , & ! DateStr
	1254	TRIM(dname) , & ! Data Name
	1255	p%ifield_2d , & ! Field
	1256	WRF_INTEGER , & ! FieldType
	1257	grid%communicator , & ! Comm
	1258	grid%iocommunicator , & ! Comm
	1259	grid%domdesc , & ! Comm
	1260	grid%bdy_mask , & ! bdy_mask
	1261	TRIM(memord) , & ! MemoryOrder
	1262	TRIM(p%Stagger) , & ! Stagger
	1263	__FILE__ // ' reading 2d integer ' // TRIM(p%VarName) , & ! Debug message
	1264	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1265	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1266	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1267	ierr )
	1268	ELSE IF ( p%Type .EQ. 'l' ) THEN
	1269	CALL wrf_ext_read_field ( &
	1270	fid , & ! DataHandle
	1271	current_date(1:19) , & ! DateStr
	1272	TRIM(dname) , & ! Data Name
	1273	p%lfield_2d , & ! Field
	1274	WRF_LOGICAL , & ! FieldType
	1275	grid%communicator , & ! Comm
	1276	grid%iocommunicator , & ! Comm
	1277	grid%domdesc , & ! Comm
	1278	grid%bdy_mask , & ! bdy_mask
	1279	TRIM(memord) , & ! MemoryOrder
	1280	TRIM(p%Stagger) , & ! Stagger
	1281	__FILE__ // ' reading 2d logical ' // TRIM(p%VarName) , & ! Debug message
	1282	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1283	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1284	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1285	ierr )
	1286	ENDIF
	1287	ENDIF
	1288	ENDIF
	1289	ENDIF
	1290	ELSE IF ( p%Ndim .EQ. 3 ) THEN
	1291	IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams,newswitch)) THEN
	1292	IF ( in_use_for_config(grid%id,TRIM(p%VarName)) .AND. &
	1293	( .NOT. p%subgrid_x .OR. (p%subgrid_x .AND. grid%sr_x .GT. 0) ) .AND. &
	1294	( .NOT. p%subgrid_y .OR. (p%subgrid_y .AND. grid%sr_y .GT. 0) ) &
	1295	) THEN
	1296	IF (switch.EQ.restart_only.OR.p%Ntl/100.EQ.mod(p%Ntl,100)) THEN
	1297	dname = p%DataName
	1298	IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
	1299	memord = p%MemoryOrder
	1300
	1301	i_inter = 0
	1302	#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
	1303	! Vertical interpolation space is required if specified by user.
	1304
	1305	if( TRIM(p%dimname2).EQ.'bottom_top'.OR.TRIM(p%dimname2).EQ.'bottom_top_stag') i_inter = 1
	1306	#endif
	1307
	1308	IF ( p%Type .EQ. 'r' ) THEN
	1309	IF( (i_inter.eq.1.and.n_ref_m.ge.2).and.(switch.eq.history_only) ) then
	1310	em2_c = (p%em2 - 1)/n_ref_m +1
	1311	ed2_c = em2_c
	1312	ep2_c = em2_c
	1313	if (TRIM(p%dimname2).EQ.'bottom_top') then
	1314	ed2_c = em2_c-1
	1315	ep2_c = em2_c-1
	1316	endif
	1317	allocate (f_vint_3d(p%sm1:p%em1,em2_c,p%sm3:p%em3))
	1318	CALL wrf_ext_read_field ( &
	1319	fid , & ! DataHandle
	1320	current_date(1:19) , & ! DateStr
	1321	TRIM(dname) , & ! Data Name
	1322	f_vint_3d , & ! Field
	1323	WRF_FLOAT , & ! FieldType
	1324	grid%communicator , & ! Comm
	1325	grid%iocommunicator , & ! Comm
	1326	grid%domdesc , & ! Comm
	1327	grid%bdy_mask , & ! bdy_mask
	1328	TRIM(memord) , & ! MemoryOrder
	1329	TRIM(p%Stagger) , & ! Stagger
	1330	__FILE__ // ' reading 3d real ' // TRIM(p%VarName) , & ! Debug message
	1331	p%sd1 , p%ed1 , p%sd2 , ed2_c , p%sd3 , p%ed3 , &
	1332	p%sm1 , p%em1 , p%sm2 , em2_c , p%sm3 , p%em3 , &
	1333	p%sp1 , p%ep1 , p%sp2 , ep2_c , p%sp3 , p%ep3 , &
	1334	ierr )
	1335
	1336	do j = p%sm3,p%em3
	1337	do k = 1,ed2_c
	1338	do i = p%sm1,p%em1
	1339	p%rfield_3d(i,k,j) = f_vint_3d(i,k,j)
	1340	enddo
	1341	enddo
	1342	enddo
	1343	deallocate (f_vint_3d)
	1344	ELSE
	1345	CALL wrf_ext_read_field ( &
	1346	fid , & ! DataHandle
	1347	current_date(1:19) , & ! DateStr
	1348	TRIM(dname) , & ! Data Name
	1349	p%rfield_3d , & ! Field
	1350	WRF_FLOAT , & ! FieldType
	1351	grid%communicator , & ! Comm
	1352	grid%iocommunicator , & ! Comm
	1353	grid%domdesc , & ! Comm
	1354	grid%bdy_mask , & ! bdy_mask
	1355	TRIM(memord) , & ! MemoryOrder
	1356	TRIM(p%Stagger) , & ! Stagger
	1357	__FILE__ // ' reading 3d real ' // TRIM(p%VarName) , & ! Debug message
	1358	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1359	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1360	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1361	ierr )
	1362	ENDIF
	1363	ELSE IF ( p%Type .EQ. 'd' ) THEN
	1364	CALL wrf_ext_read_field ( &
	1365	fid , & ! DataHandle
	1366	current_date(1:19) , & ! DateStr
	1367	TRIM(dname) , & ! Data Name
	1368	p%dfield_3d , & ! Field
	1369	WRF_DOUBLE , & ! FieldType
	1370	grid%communicator , & ! Comm
	1371	grid%iocommunicator , & ! Comm
	1372	grid%domdesc , & ! Comm
	1373	grid%bdy_mask , & ! bdy_mask
	1374	TRIM(memord) , & ! MemoryOrder
	1375	TRIM(p%Stagger) , & ! Stagger
	1376	__FILE__ // ' reading 3d double ' // TRIM(p%VarName) , & ! Debug message
	1377	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1378	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1379	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1380	ierr )
	1381	ELSE IF ( p%Type .EQ. 'i' ) THEN
	1382	CALL wrf_ext_read_field ( &
	1383	fid , & ! DataHandle
	1384	current_date(1:19) , & ! DateStr
	1385	TRIM(dname) , & ! Data Name
	1386	p%ifield_3d , & ! Field
	1387	WRF_INTEGER , & ! FieldType
	1388	grid%communicator , & ! Comm
	1389	grid%iocommunicator , & ! Comm
	1390	grid%domdesc , & ! Comm
	1391	grid%bdy_mask , & ! bdy_mask
	1392	TRIM(memord) , & ! MemoryOrder
	1393	TRIM(p%Stagger) , & ! Stagger
	1394	__FILE__ // ' reading 3d integer ' // TRIM(p%VarName) , & ! Debug message
	1395	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1396	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1397	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1398	ierr )
	1399	! NOTE no io on logical arrays greater than 2d
	1400	ENDIF
	1401	ENDIF
	1402	ENDIF
	1403	ENDIF
	1404	ELSE IF ( p%Ndim .EQ. 4 .AND. p%scalar_array ) THEN
	1405	! Use a different read routine, wrf_ext_read_field_arr, and pass in the
	1406	! tracer indeces so that p%rfield_4d can be passsed in without arguments,
	1407	! avoiding the possiblity of a copy-in/copy-out problem for some compilers.
	1408	! JM 20091208
	1409	DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
	1410	IF ((p%Restart.AND.switch.EQ.restart_only).OR.on_stream( p%streams_table(grid%id,itrace)%stream,newswitch)) THEN
	1411	dname = p%dname_table( grid%id, itrace )
	1412	IF (p%Ntl.GT.0.AND.switch.NE.restart_only)dname=dname(1:len(TRIM(dname))-2)
	1413	memord = p%MemoryOrder
	1414
	1415	i_inter = 0
	1416	#if ( ( EM_CORE == 1 ) && ( DA_CORE != 1 ) )
	1417	! Vertical interpolation space is required if specified by user.
	1418
	1419	if( TRIM(p%dimname2).EQ.'bottom_top'.OR.TRIM(p%dimname2).EQ.'bottom_top_stag') i_inter = 1
	1420	#endif
	1421
	1422	IF ( p%Type .EQ. 'r' ) THEN
	1423	IF( (i_inter.eq.1.and.n_ref_m.ge.2).and.(switch.eq.history_only) ) then
	1424	em2_c = (p%em2 - 1)/n_ref_m +1
	1425	ed2_c = em2_c
	1426	ep2_c = em2_c
	1427	if (TRIM(p%dimname2).EQ.'bottom_top') then
	1428	ed2_c = em2_c-1
	1429	ep2_c = em2_c-1
	1430	endif
	1431	allocate (f_vint_4d(p%sm1:p%em1,em2_c,p%sm3:p%em3,p%num_table(grid%id)))
	1432
	1433	CALL wrf_ext_read_field_arr ( &
	1434	fid , & ! DataHandle
	1435	current_date(1:19) , & ! DateStr
	1436	TRIM(dname) , & ! Data Name
	1437	f_vint_4d , & ! Field
	1438	itrace, 1, 1, 1 , & ! see comment above
	1439	1, 1, 1 , & ! see comment above
	1440	RWORDSIZE , &
	1441	WRF_FLOAT , & ! FieldType
	1442	grid%communicator , & ! Comm
	1443	grid%iocommunicator , & ! Comm
	1444	grid%domdesc , & ! Comm
	1445	grid%bdy_mask , & ! bdy_mask
	1446	TRIM(memord) , & ! MemoryOrder
	1447	TRIM(p%Stagger) , & ! Stagger
	1448	__FILE__ // ' reading 4d real ' // TRIM(p%dname_table(grid%id,itrace)) , & ! Debug message
	1449	p%sd1 , p%ed1 , p%sd2 , ed2_c , p%sd3 , p%ed3 , &
	1450	p%sm1 , p%em1 , p%sm2 , em2_c , p%sm3 , p%em3 , &
	1451	p%sp1 , p%ep1 , p%sp2 , ep2_c , p%sp3 , p%ep3 , &
	1452	ierr )
	1453	do j = p%sm3,p%em3
	1454	do k = 1,ed2_c
	1455	do i = p%sm1,p%em1
	1456	p%rfield_4d(i,k,j,itrace) = f_vint_4d(i,k,j,itrace)
	1457	enddo
	1458	enddo
	1459	enddo
	1460	deallocate (f_vint_4d)
	1461	ELSE
	1462	CALL wrf_ext_read_field_arr ( &
	1463	fid , & ! DataHandle
	1464	current_date(1:19) , & ! DateStr
	1465	TRIM(dname) , & ! Data Name
	1466	p%rfield_4d , & ! Field
	1467	itrace, 1, 1, 1 , & ! see comment above
	1468	1, 1, 1 , & ! see comment above
	1469	RWORDSIZE , &
	1470	WRF_FLOAT , & ! FieldType
	1471	grid%communicator , & ! Comm
	1472	grid%iocommunicator , & ! Comm
	1473	grid%domdesc , & ! Comm
	1474	grid%bdy_mask , & ! bdy_mask
	1475	TRIM(memord) , & ! MemoryOrder
	1476	TRIM(p%Stagger) , & ! Stagger
	1477	__FILE__ // ' reading 4d real ' // TRIM(p%dname_table(grid%id,itrace)) , & ! Debug message
	1478	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1479	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1480	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1481	ierr )
	1482	ENDIF
	1483	ELSE IF ( p%Type .EQ. 'd' ) THEN
	1484	CALL wrf_ext_read_field_arr ( &
	1485	fid , & ! DataHandle
	1486	current_date(1:19) , & ! DateStr
	1487	TRIM(dname) , & ! Data Name
	1488	p%dfield_4d , & ! Field
	1489	itrace, 1, 1, 1 , & ! see comment above
	1490	1, 1, 1 , & ! see comment above
	1491	DWORDSIZE , &
	1492	WRF_DOUBLE , & ! FieldType
	1493	grid%communicator , & ! Comm
	1494	grid%iocommunicator , & ! Comm
	1495	grid%domdesc , & ! Comm
	1496	grid%bdy_mask , & ! bdy_mask
	1497	TRIM(memord) , & ! MemoryOrder
	1498	TRIM(p%Stagger) , & ! Stagger
	1499	__FILE__ // ' reading 4d double ' // TRIM(p%dname_table(grid%id,itrace)) , & ! Debug message
	1500	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1501	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1502	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1503	ierr )
	1504	ELSE IF ( p%Type .EQ. 'i' ) THEN
	1505	CALL wrf_ext_read_field_arr ( &
	1506	fid , & ! DataHandle
	1507	current_date(1:19) , & ! DateStr
	1508	TRIM(dname) , & ! Data Name
	1509	p%ifield_4d , & ! Field
	1510	itrace, 1, 1, 1 , & ! see comment above
	1511	1, 1, 1 , & ! see comment above
	1512	IWORDSIZE , &
	1513	WRF_INTEGER , & ! FieldType
	1514	grid%communicator , & ! Comm
	1515	grid%iocommunicator , & ! Comm
	1516	grid%domdesc , & ! Comm
	1517	grid%bdy_mask , & ! bdy_mask
	1518	TRIM(memord) , & ! MemoryOrder
	1519	TRIM(p%Stagger) , & ! Stagger
	1520	__FILE__ // ' reading 4d integer ' // TRIM(p%dname_table(grid%id,itrace)) , & ! Debug message
	1521	p%sd1 , p%ed1 , p%sd2 , p%ed2 , p%sd3 , p%ed3 , &
	1522	p%sm1 , p%em1 , p%sm2 , p%em2 , p%sm3 , p%em3 , &
	1523	p%sp1 , p%ep1 , p%sp2 , p%ep2 , p%sp3 , p%ep3 , &
	1524	ierr )
	1525	ENDIF
	1526	ENDIF
	1527	ENDDO ! loop over tracers
	1528	ENDIF
	1529	ENDIF
	1530	p => p%next
	1531	ENDDO
	1532	ELSE
	1533	IF ( switch .EQ. boundary_only ) THEN
	1534	CALL wrf_bdyin( fid , grid , config_flags , switch , ierr )
	1535	ENDIF
	1536	ENDIF
	1537
	1538	#if (DA_CORE != 1)
	1539	CALL wrf_tsin( grid , ierr )
	1540	#if WRFMEAS
	1541	! L. Fita, LMD. May 2014
	1542	CALL wrf_lidarin( grid , ierr )
	1543	#endif
	1544
	1545	#if (EM_CORE == 1)
	1546	if (config_flags%track_loc_in > 0 ) then
	1547	call track_input( grid , ierr )
	1548	end if
	1549	#endif
	1550	#endif
	1551
	1552	WRITE(wrf_err_message,*)'input_wrf: end, fid = ',fid
	1553	CALL wrf_debug( 300 , wrf_err_message )
	1554
	1555	RETURN
	1556	END SUBROUTINE input_wrf

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

Download in other formats:

Original Format