sat_area_frac.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 sat_area_frac(PDEF,PAS,GTOPD)
!     ########################
!
!!*****    * SAT_AREA_FRAC *
!
!!    PURPOSE
!!    -------
!    
!     
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR
!!    ------
!!
!!      K. Chancibault  * LTHE / Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   27/11/2006
!!                 03/2014 (B. Vincendon) computation based of pixels counts instead of areas 
!
!----------------------------------------------------------------------
!*       0.      DECLARATIONS
!                ------------
!
USE modd_topodyn,       ONLY : nncat, nnmc, xdxt
USE modd_coupling_topd, ONLY : nmaskt, nnpix
USE modd_surf_par,        ONLY : xundef, nundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, DIMENSION(:,:),INTENT(IN)     :: PDEF    ! deficit
REAL, DIMENSION(:), INTENT(OUT)     :: PAS     !contributive area fraction in Isba meshes
LOGICAL, DIMENSION(:), INTENT(INOUT)   :: GTOPD     ! 
!
!*      0.2    declarations of local variables
INTEGER               :: JJ, JI
REAL, DIMENSION(SIZE(PAS,1)) :: ZCOUNT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------------
IF (lhook) CALL dr_hook('SAT_AREA_FRAC',0,zhook_handle)
!
!*       0.     Initialization:
! 
pas(:)=0.0
!
DO jj=1,nncat
 IF (gtopd(jj)) THEN
  DO ji=1,nnmc(jj)
    IF (pdef(jj,ji)==0.0 .AND. nmaskt(jj,ji)/=nundef .AND. nmaskt(jj,ji)/=0) THEN 
      pas(nmaskt(jj,ji)) = pas(nmaskt(jj,ji)) +1. 
    ENDIF
  ENDDO
 ENDIF
ENDDO
!
! Calculation of the saturated area ratio in each Isba mesh
WHERE ((nnpix/=0.).AND.(pas/=xundef))
  pas(:) = pas(:) / nnpix(:)
ENDWHERE
!
IF (lhook) CALL dr_hook('SAT_AREA_FRAC',1,zhook_handle)
!
END SUBROUTINE sat_area_frac