read_binllvfast.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_binllvfast (UG, U, USS, &
                                  HPROGRAM,HSUBROUTINE,HFILENAME)
!     ##############################################################
!
!!**** *READ_BINLLVFAST* reads a binary latlonvalue file and call treatment 
!!                   subroutine : optimized version of READ_BINLLV routine.
!!
!!    PURPOSE
!!    -------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    D. Gazen          L.A.
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    29/11/2002
!!                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_surf_par,   ONLY : xundef
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 units
INTEGER                                :: JLAT, JLON ! indexes of LLATLONMASK array
INTEGER                                :: INELT      ! number of data points in file 
INTEGER                                :: ICPT       ! number of data points to be computed
REAL,DIMENSION(:,:),ALLOCATABLE,TARGET :: ZLLV       ! ZLLV(1,:) :: latitude of data points
                                                     ! ZLLV(2,:) :: longitude of data points
                                                     ! ZLLV(3,:) :: value of data points
REAL, DIMENSION(:), ALLOCATABLE :: ZLLV2
REAL,DIMENSION(:,:),POINTER            :: ZLLVWORK   ! point on ZLLV array 
INTEGER                                :: JI         ! loop counter
!
INTEGER                                :: ILUOUT     ! output listing
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
!
!*    1.      Open the global file
!             --------------------
!
IF (lhook) CALL dr_hook('READ_BINLLVFAST',0,zhook_handle)
 CALL open_file(hprogram,iglb,hfilename,'UNFORMATTED',haction='READ')
!
 CALL get_luout(hprogram,iluout)
!
!----------------------------------------------------------------------------
!
!*    3.     Reading of a data point
!            -----------------------
!
READ(iglb) inelt ! number of data points
ALLOCATE(zllv(3,inelt))
ALLOCATE(zllv2(inelt))
READ(iglb) zllv
!
!----------------------------------------------------------------------------
!
!*    4.     Test if point is in the domain
!            ------------------------------
!
zllv2(:) = zllv(2,:)+nint((180.-zllv(2,:))/360.)*360.
!
icpt = 0
DO ji=1,inelt
  jlat = 1 + int( ( zllv(1,ji)+ 90. ) * 2. )
  jlat = min(jlat,360)
  jlon = 1 + int( ( zllv2(ji)       ) * 2. )
  jlon = min(jlon,720)
  IF (llatlonmask(jlon,jlat)) THEN
    icpt = icpt+1
    zllv(:,icpt) = zllv(:,ji)
  END IF
END DO
!
!-------------------------------------------------------------------------------
!
!*    5.     Call to the adequate subroutine (point by point treatment)
!            ----------------------------------------------------------
!     
IF (icpt > 0) THEN
  zllvwork=>zllv(:,1:icpt)
  CALL pt_by_pt_treatment(ug, u, uss, &
                          iluout,zllvwork(1,:),zllvwork(2,:),zllvwork(3,:),hsubroutine)
END IF
!
!----------------------------------------------------------------------------
!
!*    6.    Closing of the data file
!           ------------------------
!
 CALL close_file (hprogram,iglb)
!
!-------------------------------------------------------------------------------
!
DEALLOCATE(zllv)
IF (lhook) CALL dr_hook('READ_BINLLVFAST',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_binllvfast