SUBROUTINE wrf_tsin ( grid , ierr )
USE module_domain
USE module_utility
IMPLICIT NONE
integer, parameter :: WRF_FILE_NOT_OPENED = 100
integer, parameter :: WRF_FILE_OPENED_NOT_COMMITTED = 101
integer, parameter :: WRF_FILE_OPENED_FOR_WRITE = 102
integer, parameter :: WRF_FILE_OPENED_FOR_READ = 103
integer, parameter :: WRF_REAL = 104
integer, parameter :: WRF_DOUBLE = 105
integer, parameter :: WRF_FLOAT=WRF_REAL
integer, parameter :: WRF_INTEGER = 106
integer, parameter :: WRF_LOGICAL = 107
integer, parameter :: WRF_COMPLEX = 108
integer, parameter :: WRF_DOUBLE_COMPLEX = 109
integer, parameter :: WRF_FILE_OPENED_FOR_UPDATE = 110
! This bit is for backwards compatibility with old variants of these flags
! that are still being used in io_grib1 and io_phdf5. It should be removed!
integer, parameter :: WRF_FILE_OPENED_AND_COMMITTED = 102
!WRF Error and Warning messages (1-999)
!All i/o package-specific status codes you may want to add must be handled by your package (see below)
! WRF handles these and netCDF messages only
integer, parameter :: WRF_NO_ERR = 0 !no error
integer, parameter :: WRF_WARN_FILE_NF = -1 !file not found, or incomplete
integer, parameter :: WRF_WARN_MD_NF = -2 !metadata not found
integer, parameter :: WRF_WARN_TIME_NF = -3 !timestamp not found
integer, parameter :: WRF_WARN_TIME_EOF = -4 !no more timestamps
integer, parameter :: WRF_WARN_VAR_NF = -5 !variable not found
integer, parameter :: WRF_WARN_VAR_EOF = -6 !no more variables for the current time
integer, parameter :: WRF_WARN_TOO_MANY_FILES = -7 !too many open files
integer, parameter :: WRF_WARN_TYPE_MISMATCH = -8 !data type mismatch
integer, parameter :: WRF_WARN_WRITE_RONLY_FILE = -9 !attempt to write readonly file
integer, parameter :: WRF_WARN_READ_WONLY_FILE = -10 !attempt to read writeonly file
integer, parameter :: WRF_WARN_FILE_NOT_OPENED = -11 !attempt to access unopened file
integer, parameter :: WRF_WARN_2DRYRUNS_1VARIABLE = -12 !attempt to do 2 trainings for 1 variable
integer, parameter :: WRF_WARN_READ_PAST_EOF = -13 !attempt to read past EOF
integer, parameter :: WRF_WARN_BAD_DATA_HANDLE = -14 !bad data handle
integer, parameter :: WRF_WARN_WRTLEN_NE_DRRUNLEN = -15 !write length not equal to training length
integer, parameter :: WRF_WARN_TOO_MANY_DIMS = -16 !more dimensions requested than training
integer, parameter :: WRF_WARN_COUNT_TOO_LONG = -17 !attempt to read more data than exists
integer, parameter :: WRF_WARN_DIMENSION_ERROR = -18 !input dimension inconsistent
integer, parameter :: WRF_WARN_BAD_MEMORYORDER = -19 !input MemoryOrder not recognized
integer, parameter :: WRF_WARN_DIMNAME_REDEFINED = -20 !a dimension name with 2 different lengths
integer, parameter :: WRF_WARN_CHARSTR_GT_LENDATA = -21 !string longer than provided storage
integer, parameter :: WRF_WARN_NOTSUPPORTED = -22 !function not supportable
integer, parameter :: WRF_WARN_NOOP = -23 !package implements this routine as NOOP
!Fatal errors
integer, parameter :: WRF_ERR_FATAL_ALLOCATION_ERROR = -100 !allocation error
integer, parameter :: WRF_ERR_FATAL_DEALLOCATION_ERR = -101 !dealloc error
integer, parameter :: WRF_ERR_FATAL_BAD_FILE_STATUS = -102 !bad file status
!Package specific errors (1000+)
!Netcdf status codes
!WRF will accept status codes of 1000+, but it is up to the package to handle
! and return the status to the user.
integer, parameter :: WRF_ERR_FATAL_BAD_VARIABLE_DIM = -1004
integer, parameter :: WRF_ERR_FATAL_MDVAR_DIM_NOT_1D = -1005
integer, parameter :: WRF_ERR_FATAL_TOO_MANY_TIMES = -1006
integer, parameter :: WRF_WARN_BAD_DATA_TYPE = -1007 !this code not in either spec?
integer, parameter :: WRF_WARN_FILE_NOT_COMMITTED = -1008 !this code not in either spec?
integer, parameter :: WRF_WARN_FILE_OPEN_FOR_READ = -1009
integer, parameter :: WRF_IO_NOT_INITIALIZED = -1010
integer, parameter :: WRF_WARN_MD_AFTER_OPEN = -1011
integer, parameter :: WRF_WARN_TOO_MANY_VARIABLES = -1012
integer, parameter :: WRF_WARN_DRYRUN_CLOSE = -1013
integer, parameter :: WRF_WARN_DATESTR_BAD_LENGTH = -1014
integer, parameter :: WRF_WARN_ZERO_LENGTH_READ = -1015
integer, parameter :: WRF_WARN_DATA_TYPE_NOT_FOUND = -1016
integer, parameter :: WRF_WARN_DATESTR_ERROR = -1017
integer, parameter :: WRF_WARN_DRYRUN_READ = -1018
integer, parameter :: WRF_WARN_ZERO_LENGTH_GET = -1019
integer, parameter :: WRF_WARN_ZERO_LENGTH_PUT = -1020
integer, parameter :: WRF_WARN_NETCDF = -1021
integer, parameter :: WRF_WARN_LENGTH_LESS_THAN_1 = -1022
integer, parameter :: WRF_WARN_MORE_DATA_IN_FILE = -1023
integer, parameter :: WRF_WARN_DATE_LT_LAST_DATE = -1024
! For 1 only
integer, parameter :: WRF_HDF5_ERR_FILE = -200
integer, parameter :: WRF_HDF5_ERR_MD = -201
integer, parameter :: WRF_HDF5_ERR_TIME = -202
integer, parameter :: WRF_HDF5_ERR_TIME_EOF = -203
integer, parameter :: WRF_HDF5_ERR_MORE_DATA_IN_FILE = -204
integer, parameter :: WRF_HDF5_ERR_DATE_LT_LAST_DATE = -205
integer, parameter :: WRF_HDF5_ERR_TOO_MANY_FILES = -206
integer, parameter :: WRF_HDF5_ERR_TYPE_MISMATCH = -207
integer, parameter :: WRF_HDF5_ERR_LENGTH_LESS_THAN_1 = -208
integer, parameter :: WRF_HDF5_ERR_WRITE_RONLY_FILE = -209
integer, parameter :: WRF_HDF5_ERR_READ_WONLY_FILE = -210
integer, parameter :: WRF_HDF5_ERR_FILE_NOT_OPENED = -211
integer, parameter :: WRF_HDF5_ERR_DATESTR_ERROR = -212
integer, parameter :: WRF_HDF5_ERR_DRYRUN_READ = -213
integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_GET = -214
integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_PUT = -215
integer, parameter :: WRF_HDF5_ERR_2DRYRUNS_1VARIABLE = -216
integer, parameter :: WRF_HDF5_ERR_DATA_TYPE_NOTFOUND = -217
integer, parameter :: WRF_HDF5_ERR_READ_PAST_EOF = -218
integer, parameter :: WRF_HDF5_ERR_BAD_DATA_HANDLE = -219
integer, parameter :: WRF_HDF5_ERR_WRTLEN_NE_DRRUNLEN = -220
integer, parameter :: WRF_HDF5_ERR_DRYRUN_CLOSE = -221
integer, parameter :: WRF_HDF5_ERR_DATESTR_BAD_LENGTH = -222
integer, parameter :: WRF_HDF5_ERR_ZERO_LENGTH_READ = -223
integer, parameter :: WRF_HDF5_ERR_TOO_MANY_DIMS = -224
integer, parameter :: WRF_HDF5_ERR_TOO_MANY_VARIABLES = -225
integer, parameter :: WRF_HDF5_ERR_COUNT_TOO_LONG = -226
integer, parameter :: WRF_HDF5_ERR_DIMENSION_ERROR = -227
integer, parameter :: WRF_HDF5_ERR_BAD_MEMORYORDER = -228
integer, parameter :: WRF_HDF5_ERR_DIMNAME_REDEFINED = -229
integer, parameter :: WRF_HDF5_ERR_MD_AFTER_OPEN = -230
integer, parameter :: WRF_HDF5_ERR_CHARSTR_GT_LENDATA = -231
integer, parameter :: WRF_HDF5_ERR_BAD_DATA_TYPE = -232
integer, parameter :: WRF_HDF5_ERR_FILE_NOT_COMMITTED = -233
integer, parameter :: WRF_HDF5_ERR_ALLOCATION = -2001
integer, parameter :: WRF_HDF5_ERR_DEALLOCATION = -2002
integer, parameter :: WRF_HDF5_ERR_BAD_FILE_STATUS = -2003
integer, parameter :: WRF_HDF5_ERR_BAD_VARIABLE_DIM = -2004
integer, parameter :: WRF_HDF5_ERR_MDVAR_DIM_NOT_1D = -2005
integer, parameter :: WRF_HDF5_ERR_TOO_MANY_TIMES = -2006
integer, parameter :: WRF_HDF5_ERR_DATA_ID_NOTFOUND = -2007
integer, parameter :: WRF_HDF5_ERR_DATASPACE = -300
integer, parameter :: WRF_HDF5_ERR_DATATYPE = -301
integer, parameter :: WRF_HDF5_ERR_PROPERTY_LIST = -302
integer, parameter :: WRF_HDF5_ERR_DATASET_CREATE = -303
integer, parameter :: WRF_HDF5_ERR_DATASET_READ = -304
integer, parameter :: WRF_HDF5_ERR_DATASET_WRITE = -305
integer, parameter :: WRF_HDF5_ERR_DATASET_OPEN = -306
integer, parameter :: WRF_HDF5_ERR_DATASET_GENERAL = -307
integer, parameter :: WRF_HDF5_ERR_GROUP = -308
integer, parameter :: WRF_HDF5_ERR_FILE_OPEN = -309
integer, parameter :: WRF_HDF5_ERR_FILE_CREATE = -310
integer, parameter :: WRF_HDF5_ERR_DATASET_CLOSE = -311
integer, parameter :: WRF_HDF5_ERR_FILE_CLOSE = -312
integer, parameter :: WRF_HDF5_ERR_CLOSE_GENERAL = -313
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CREATE = -314
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_READ = -315
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_WRITE = -316
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OPEN = -317
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_GENERAL = -318
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_CLOSE = -319
integer, parameter :: WRF_HDF5_ERR_OTHERS = -320
integer, parameter :: WRF_HDF5_ERR_ATTRIBUTE_OTHERS = -321
TYPE(domain), INTENT(INOUT) :: grid
INTEGER, INTENT(INOUT) :: ierr
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
INTEGER, EXTERNAL :: get_unused_unit
REAL, ALLOCATABLE, DIMENSION(:) :: lattslocs, lontslocs
INTEGER :: istatus, iunit
LOGICAL :: exists
CHARACTER (LEN=256) :: errmess
ierr = 0
grid%ntsloc = 0
grid%have_calculated_tslocs = .FALSE.
IF ( grid%max_ts_locs <= 0 ) RETURN
IF ( wrf_dm_on_monitor() ) THEN
CALL wrf_tsin_exist ( exists )
IF (exists) THEN
iunit = get_unused_unit()
IF ( iunit <= 0 ) THEN
CALL wrf_error_fatal3("wrf_tsin.b",41,&
'Error in wrf_tsin: could not find a free Fortran unit.')
END IF
OPEN(UNIT=iunit, FILE='tslist', FORM='formatted', STATUS='old', IOSTAT=istatus)
IF (istatus == 0) THEN
READ(UNIT=iunit, FMT='(1X)')
READ(UNIT=iunit, FMT='(1X)')
READ(UNIT=iunit, FMT='(1X)')
istatus = 0
DO WHILE (istatus == 0)
READ(UNIT=iunit, FMT='(A25,1X,A5,1X,F7.3,1X,F8.3)', IOSTAT=istatus) &
grid%desctsloc(grid%ntsloc+1), grid%nametsloc(grid%ntsloc+1), &
grid%lattsloc(grid%ntsloc+1), grid%lontsloc(grid%ntsloc+1)
IF (istatus == 0) grid%ntsloc = grid%ntsloc + 1
IF (istatus > 0) THEN
WRITE(errmess, FMT='(I4)') grid%ntsloc + 3
CALL wrf_message('Error in tslist, line '//trim(errmess))
EXIT
END IF
IF ( grid%ntsloc >= grid%max_ts_locs ) THEN
IF ( istatus == 0 ) THEN
WRITE(errmess, FMT='(A,I4,A)') 'Ignoring all time series locations beyond #', &
grid%ntsloc,'. Increase max_ts_locs in namelist.input'
CALL wrf_message(trim(errmess))
END IF
EXIT
END IF
END DO
CLOSE(iunit)
END IF
END IF
END IF
CALL wrf_dm_bcast_integer(grid%ntsloc, 1)
CALL wrf_dm_bcast_real(grid%lattsloc, grid%max_ts_locs)
CALL wrf_dm_bcast_real(grid%lontsloc, grid%max_ts_locs)
END SUBROUTINE wrf_tsin
SUBROUTINE wrf_tsin_exist ( exists )
IMPLICIT NONE
LOGICAL , INTENT(OUT) :: exists
INQUIRE(FILE='tslist', EXIST=exists)
END SUBROUTINE wrf_tsin_exist
INTEGER FUNCTION get_unused_unit()
IMPLICIT NONE
INTEGER, PARAMETER :: min_unit_number = 30
INTEGER, PARAMETER :: max_unit_number = 99
LOGICAL :: opened
DO get_unused_unit = min_unit_number, max_unit_number
INQUIRE(UNIT=get_unused_unit, OPENED=opened)
IF ( .NOT. opened ) RETURN
END DO
get_unused_unit = -1
RETURN
END FUNCTION get_unused_unit