read_binllv.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE read_binllv (UG, U, USS, &
                              HPROGRAM,HSUBROUTINE,HFILENAME)
!     ##############################################################
!
!!**** *READ_BINLLV* reads a binary latlonvalue file and call treatment 
!!                   subroutine
!!
!!    PURPOSE
!!    -------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson          Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    12/09/95
!!                03/2004  externalization (V. Masson)
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_sso_n, ONLY : sso_t
!
USE modd_pgd_grid,   ONLY : llatlonmask
!
USE modi_open_file
USE modi_close_file
USE modi_pt_by_pt_treatment
USE modi_get_luout
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(sso_t), INTENT(INOUT) :: USS
!
 CHARACTER(LEN=6),  INTENT(IN) :: HPROGRAM      ! Type of program
 CHARACTER(LEN=6),  INTENT(IN) :: HSUBROUTINE   ! Name of the subroutine to call
 CHARACTER(LEN=28), INTENT(IN) :: HFILENAME     ! Name of the field file.
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER      :: IGLB                       ! logical unit
!
INTEGER      :: JLAT, JLON                 ! indexes of OLATLONMASK array
!
INTEGER, PARAMETER :: ILONG=1000
!
REAL*4         :: ZVALUER
REAL, DIMENSION(ILONG) :: ZVALUE          ! values of a data point
REAL*4         :: ZLATR
REAL, DIMENSION(ILONG) :: ZLAT              ! latitude of data point
REAL*4         :: ZLONR, ZLONR2
REAL, DIMENSION(ILONG) :: ZLON              ! longitude of data point
!
INTEGER :: ICPT, ISTAT
INTEGER      :: ILUOUT                     ! output listing
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
!*    1.      Open the file
!             -------------
!
IF (lhook) CALL dr_hook('READ_BINLLV',0,zhook_handle)
 CALL open_file(hprogram,iglb,hfilename,'UNFORMATTED',haction='READ')
!
 CALL get_luout(hprogram,iluout)
!
icpt = 0
!
zlat(:) = 0
zlon(:) = 0
zvalue(:) = 0
!
!----------------------------------------------------------------------------
DO
!----------------------------------------------------------------------------
!
!*    3.     Reading of a data point
!            -----------------------
!
  READ(iglb,iostat=istat) zlatr,zlonr,zvaluer
!
!----------------------------------------------------------------------------
!
!*    4.     Test if point is in the domain
!            ------------------------------
!
  IF (istat==0) THEN
    !
    zlonr2=zlonr+nint((180.-zlonr)/360.)*360.
    !
    jlat = 1 + int( ( zlatr + 90. ) * 2. )
    jlat = min(jlat,360)
    jlon = 1 + int( ( zlonr2      ) * 2. )
    jlon = min(jlon,720)
    !
    IF (.NOT. llatlonmask(jlon,jlat)) cycle
    !
    icpt = icpt + 1
    !
    IF (icpt<=ilong) THEN
      !
      zlat(icpt) = zlatr
      zlon(icpt) = zlonr
      zvalue(icpt) = zvaluer
      !
    ENDIF
    !
  ENDIF
    !
  IF (istat==-1 .OR. icpt==ilong) THEN
    !
    !-------------------------------------------------------------------------------
    !
    !*    5.     Call to the adequate subroutine (point by point treatment)
    !            ----------------------------------------------------------
    !     
    CALL pt_by_pt_treatment(ug, u, uss, iluout, &
            zlat(1:icpt), zlon(1:icpt), zvalue(1:icpt), hsubroutine    )  
    !
    icpt = 0
    zlat(:) = 0.
    zlon(:) = 0.
    zvalue(:) = 0.
    !
  ENDIF
  !
  IF (istat==-1) EXIT
  !
  !-------------------------------------------------------------------------------
ENDDO
!
!----------------------------------------------------------------------------
!
!*    8.    Closing of the data file
!           ------------------------
!
 CALL close_file (hprogram,iglb)
IF (lhook) CALL dr_hook('READ_BINLLV',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_binllv