SUBROUTINE track_input ( grid , ierr ) 1,13
USE module_domain
USE module_utility
IMPLICIT NONE
#include <wrf_io_flags.h>
#include <wrf_status_codes.h>
TYPE(domain), INTENT(INOUT) :: grid
INTEGER, INTENT(INOUT) :: ierr
#if ( EM_CORE == 1 )
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
INTEGER, EXTERNAL :: get_unused_unit
INTEGER :: istatus, iunit, istatus2
LOGICAL :: exists
CHARACTER (LEN=256) :: errmess
ierr = 0
#ifndef NETCDF
call wrf_message
( 'calc_track_locations: requires netcdf' )
call wrf_abort
#endif
#if ( DA_CORE != 1 )
IF ( grid%dfi_opt == DFI_NODFI .OR. (grid%dfi_opt /= DFI_NODFI .AND. grid%dfi_stage == DFI_SETUP) ) THEN
#endif
IF ( grid%track_have_input .or. grid%track_loc_in <= 0 ) then
RETURN
ENDIF
grid%track_loc = 0
master_proc : &
IF ( wrf_dm_on_monitor() ) THEN
INQUIRE(FILE='wrfinput_track.txt', EXIST=exists)
have_input_file : &
IF (exists) THEN
iunit = get_unused_unit
()
IF ( iunit <= 0 ) THEN
CALL wrf_error_fatal
('Error in track_input: could not find a free Fortran unit.')
END IF
! Input track locations
OPEN(UNIT=iunit, FILE='wrfinput_track.txt', FORM='formatted', STATUS='old', IOSTAT=istatus)
IF (istatus == 0) THEN
! Read in track locations
istatus2 = 0
DO WHILE (istatus2 == 0)
READ(UNIT=iunit, FMT='(A19,1X,F7.3,1X,F8.3)', IOSTAT=istatus2) &
grid%track_time_in(grid%track_loc+1), &
grid%track_lat_in(grid%track_loc+1), &
grid%track_lon_in(grid%track_loc+1)
if (istatus2 == 0 ) then
grid%track_loc = grid%track_loc + 1
elseif (istatus2 > 0) then
WRITE(errmess, FMT='(I4)') grid%track_loc + 1 ! One extra for the header of the file
CALL wrf_message
('Error in track_input.txt, line '//trim(errmess))
EXIT ! (technically unecessary, as we will exit the loop anyway)
endif
IF ( grid%track_loc >= grid%track_loc_in ) THEN
IF ( istatus2 == 0 ) THEN ! Assume there were more lines in the file
WRITE(errmess, FMT='(A,I4,A)') 'Ignoring all track locations beyond #', &
grid%track_loc,'. Increase track_loc_in in namelist.input'
CALL wrf_message
(trim(errmess))
ENDIF
EXIT
ENDIF
END DO ! istatus2 == 0
CLOSE(iunit)
ENDIF ! istatus == 0
ELSE have_input_file
CALL wrf_error_fatal
('Error in track_input: could not find wrfinput_track.txt file.')
ENDIF have_input_file
write(errmess,*) 'track_input: total input locations = ',grid%track_loc
call wrf_message
( trim(errmess) )
! print *,'track_input: track_loc_in = ',grid%track_loc_in
ENDIF master_proc
#ifdef DM_PARALLEL
CALL wrf_dm_bcast_integer
(grid%track_loc, 1)
CALL wrf_dm_bcast_real
(grid%track_time_in, grid%track_loc)
CALL wrf_dm_bcast_real
(grid%track_lat_in, grid%track_loc)
CALL wrf_dm_bcast_real
(grid%track_lon_in, grid%track_loc)
#endif
grid%track_have_input = .TRUE.
#if ( DA_CORE != 1 )
END IF
#endif
#endif
END SUBROUTINE track_input