source: lmdz_wrf/branches/LMDZ_WRFmeas/WRFV3/share/wrf_lidarin.F @ 103

SUBROUTINE wrf_lidarin ( grid , ierr )

    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

    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