compare_orography.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 compare_orography (DTCO, U, HPROGRAM, OSURFZS, PDELT_ZSMAX  )
!**************************************************************************
!
!!    PURPOSE
!!    -------
!!        Check consistency orographies read from forcing file and from initial file
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      P. Le Moigne   *Meteo France*
!!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modi_init_io_surf_n
USE modi_read_surf
USE modi_end_io_surf_n
USE modi_get_luout
USE modd_surf_par,   ONLY : xundef
USE modd_forc_atm,   ONLY : xzs
USE modd_surf_conf,  ONLY : cprogname
!         
USE modi_set_surfex_filein
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
! global variables
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
 CHARACTER(LEN=6)    ,INTENT(IN)  :: HPROGRAM
REAL                ,INTENT(IN)  :: PDELT_ZSMAX
LOGICAL             ,INTENT(IN)  :: OSURFZS

! local variables
INTEGER                          :: ILUOUT
INTEGER                          :: IRET
REAL, DIMENSION(SIZE(XZS,1))     :: ZS1       ! orography read from FORCING.nc
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('COMPARE_OROGRAPHY',0,zhook_handle)
cprogname = hprogram
!
! read orography
! 
!  orography from initial file
 CALL set_surfex_filein(hprogram,'PGD ') ! change input file name to pgd name
 CALL init_io_surf_n(dtco, u, hprogram,'FULL  ','SURF  ','READ ') 
 CALL read_surf(hprogram,'ZS', zs1, iret)
 CALL end_io_surf_n(hprogram)
 CALL set_surfex_filein(hprogram,'PREP') ! restore input file name
!
IF (osurfzs) THEN
  CALL get_luout('ASCII ',iluout)
  WRITE(iluout,*)' OROGRAPHY READ FROM INITIAL FILE'
  xzs(:) = zs1(:)
ELSEIF (maxval(abs(xzs(:)-zs1(:))) > pdelt_zsmax) THEN
  CALL get_luout('ASCII ',iluout)
  WRITE(iluout,*)' DIFFERENCE OF OROGRAPHY TOO BIG BETWEEN FORCING AND INITIAL FILE'
  WRITE(iluout,*)' Maximum orography difference allowed (m) : ', pdelt_zsmax
  WRITE(iluout,*)' Maximum orography difference         (m) : ', maxval(abs(xzs(:)-zs1(:)))
  CALL abor1_sfx('COMPARE_OROGRAPHY: DIFFERENCE OF OROGRAPHY TOO BIG BETWEEN FORCING AND INITIAL FILE')
ENDIF
!
IF (lhook) CALL dr_hook('COMPARE_OROGRAPHY',1,zhook_handle)
!
END SUBROUTINE compare_orography