diag_isba_to_rout.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 diag_isba_to_rout (UG, &
                                    pvarc,pvarcp,pvarrout)
!     ############################
!
!!****  *DIAG_ISBA_TO_ROUT*  
!!
!!    PURPOSE
!!    -------
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR
!!    ------
!!
!!      K. Chancibault  * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   10/11/2006
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
!
USE modd_surf_par,        ONLY: xundef
USE modd_csts,            ONLY: xrholw
USE modd_topodyn, ONLY : xtopd_step
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
!
REAL,DIMENSION(:),INTENT(IN)        :: pvarc       ! Current time step cumulated diagnostic from SurfEx
REAL,DIMENSION(:),INTENT(IN)        :: pvarcp      ! Previous time step cumulated diagnostic from SurfEx 
REAL,DIMENSION(:),INTENT(OUT)       :: pvarrout    ! Not cumulated diagnostic (m3/s)
!
!*      0.2    declarations of local variables
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('DIAG_ISBA_TO_ROUT',0,zhook_handle)
!
!*       0.     Initialization:
!               ---------------
pvarrout=xundef
!
IF ( SIZE(pvarc,1)==SIZE(pvarcp,1) ) THEN
  !
  WHERE ( pvarc/=xundef )
    pvarrout = pvarc - pvarcp
    pvarrout = pvarrout / xtopd_step
    pvarrout = pvarrout * ug%XMESH_SIZE / xrholw
  ENDWHERE
  !
ELSE 
  !
  WRITE(*,*) 'Pb with diagnostic to rout'
  CALL abor1_sfx("DIAG_ISBA_TO_ROUT: PB WITH DIAGNOSTIC TO ROUT ")
  !
ENDIF
!
WHERE (pvarrout<0.) pvarrout = 0.
!
IF (lhook) CALL dr_hook('DIAG_ISBA_TO_ROUT',1,zhook_handle)
!
END SUBROUTINE diag_isba_to_rout