SUBROUTINE wrf_tsin ( grid , ierr ) USE module_domain USE module_utility USE module_configure, ONLY : model_config_rec, grid_config_rec_type, model_to_grid_config_rec USE module_string_tools, ONLY : capitalize 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 HDF5 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 TYPE (grid_config_rec_type) :: config_flags INTEGER, INTENT(INOUT) :: ierr LOGICAL, EXTERNAL :: wrf_dm_on_monitor INTEGER, EXTERNAL :: get_unused_unit INTEGER :: istatus, iunit LOGICAL :: exists CHARACTER (LEN=256) :: errmess CHARACTER (LEN=256) :: IorLat,JorLon ierr = 0 IF ( grid%dfi_opt == DFI_NODFI .OR. (grid%dfi_opt /= DFI_NODFI .AND. grid%dfi_stage == DFI_SETUP) ) THEN CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags ) 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",44,& '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='(32X,A7,2X,A7)') IorLat, JorLon READ(UNIT=iunit, FMT='(1X)') grid%tslist_ij = .false. IorLat = capitalize(IorLat) JorLon = capitalize(JorLon) if(index(IorLat,'LAT').ne.0 .and. index(JorLon,'LON').ne.0) then grid%tslist_ij = .false. elseif(index(IorLat,'I').ne.0 .and. index(JorLon,'J').ne.0) then grid%tslist_ij = .true. else CALL wrf_error_fatal3("wrf_tsin.b",68,& 'Error in wrf_tsin: Header line requires either LAT LON or I J') endif istatus = 0 DO WHILE (istatus == 0) IF (config_flags%map_proj == 0 .OR. grid%tslist_ij) THEN READ(UNIT=iunit, FMT='(A25,1X,A5,1X,I7,1X,I8)', IOSTAT=istatus) & grid%desctsloc(grid%ntsloc+1), grid%nametsloc(grid%ntsloc+1), & grid%itsloc(grid%ntsloc+1), grid%jtsloc(grid%ntsloc+1) ELSE 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) END IF IF (istatus == 0) grid%ntsloc = grid%ntsloc + 1 IF (istatus > 0) THEN WRITE(errmess, FMT='(I4)') grid%ntsloc + 4 CALL wrf_message('Error in tslist, line '//trim(errmess)) CALL wrf_error_fatal3("wrf_tsin.b",92,& 'Error --- Maybe check that the header (I,J) vs (LAT,LON) matches the provided information') EXIT END IF IF ( ( grid%ntsloc == 1 ) .and. ( .NOT. grid%tslist_ij ) ) THEN IF ( ( ABS(grid%lattsloc(grid%ntsloc)) <= 0.1 ) .and. & ( ABS(grid%lontsloc(grid%ntsloc)) <= 0.1 ) ) THEN CALL wrf_message('WARNING ') CALL wrf_message('WARNING --- Maybe you have (I,J) locations for the (LAT,LON) values in tslist?') CALL wrf_message('WARNING --- Are you purposefully studying Null Island?') CALL wrf_message('WARNING ') END IF 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_integer(grid%tslist_ij, 1) CALL wrf_dm_bcast_real(grid%lattsloc, grid%max_ts_locs) CALL wrf_dm_bcast_real(grid%lontsloc, grid%max_ts_locs) CALL wrf_dm_bcast_integer(grid%itsloc, grid%max_ts_locs) CALL wrf_dm_bcast_integer(grid%jtsloc, grid%max_ts_locs) END IF 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