SUBROUTINE wrf_lidarin ( grid , ierr ) USE module_domain USE module_utility IMPLICIT NONE #include #include TYPE(domain), INTENT(INOUT) :: grid INTEGER, INTENT(INOUT) :: ierr LOGICAL, EXTERNAL :: wrf_dm_on_monitor INTEGER, EXTERNAL :: get_unused_unit REAL, ALLOCATABLE, DIMENSION(:) :: latlidarlocs, lonlidarlocs INTEGER :: istatus, iunit LOGICAL :: exists CHARACTER (LEN=256) :: errmess ierr = 0 #if ((EM_CORE == 1) && (DA_CORE != 1)) IF ( grid%dfi_opt == DFI_NODFI .OR. (grid%dfi_opt /= DFI_NODFI .AND. grid%dfi_stage == DFI_SETUP) ) THEN #endif grid%nlidarloc = 0 grid%have_calculated_lidarlocs = .FALSE. IF ( grid%max_lidar_locs <= 0 ) RETURN IF ( wrf_dm_on_monitor() ) THEN INQUIRE(FILE='lidarlist', EXIST=exists) IF (exists) THEN iunit = get_unused_unit() IF ( iunit <= 0 ) THEN CALL wrf_error_fatal('Error in wrf_lidarin: could not find a free Fortran unit.') END IF ! Input time series locations OPEN(UNIT=iunit, FILE='lidarlist', FORM='formatted', STATUS='old', IOSTAT=istatus) IF (istatus == 0) THEN ! Ignore first three lines, which constitute a header READ(UNIT=iunit, FMT='(1X)') READ(UNIT=iunit, FMT='(1X)') READ(UNIT=iunit, FMT='(1X)') ! Read in time series locations istatus = 0 DO WHILE (istatus == 0) READ(UNIT=iunit, FMT='(A25,1X,A5,1X,F7.3,1X,F8.3)', IOSTAT=istatus) & grid%desclidarloc(grid%nlidarloc+1), grid%namelidarloc(grid%nlidarloc+1), & grid%latlidarloc(grid%nlidarloc+1), grid%lonlidarloc(grid%nlidarloc+1) IF (istatus == 0) grid%nlidarloc = grid%nlidarloc + 1 IF (istatus > 0) THEN WRITE(errmess, FMT='(I4)') grid%nlidarloc + 3 ! Three extra for the header of the file CALL wrf_message('Error in lidarlist, line '//trim(errmess)) EXIT ! (technically unecessary, as we will exit the loop anyway) END IF IF ( grid%nlidarloc >= grid%max_lidar_locs ) THEN IF ( istatus == 0 ) THEN ! Assume there were more lines in the file WRITE(errmess, FMT='(A,I4,A)') 'Ignoring all time series locations beyond #', & grid%nlidarloc,'. Increase max_lidar_locs in namelist.input' CALL wrf_message(trim(errmess)) END IF EXIT END IF END DO CLOSE(iunit) END IF END IF ! lidarlist file exists END IF #ifdef DM_PARALLEL CALL wrf_dm_bcast_integer(grid%nlidarloc, 1) CALL wrf_dm_bcast_real(grid%latlidarloc, grid%max_lidar_locs) CALL wrf_dm_bcast_real(grid%lonlidarloc, grid%max_lidar_locs) #endif #if ((EM_CORE == 1) && (DA_CORE != 1)) END IF #endif END SUBROUTINE wrf_lidarin ! L. Fita, LMD. May 2014 ! Already defined as function by wrf_timeseries.F ! !!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