SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TOPD/sat_area

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     ########################
00003       SUBROUTINE SAT_AREA_FRAC(PDEF,PAS)
00004 !     ########################
00005 !
00006 !!*****    * SAT_AREA_FRAC *
00007 !
00008 !!    PURPOSE
00009 !!    -------
00010 !    
00011 !     
00012 !         
00013 !     
00014 !!**  METHOD
00015 !!    ------
00016 !
00017 !!    EXTERNAL
00018 !!    --------
00019 !!
00020 !!    none
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------ 
00024 !!
00025 !!    
00026 !!    
00027 !!
00028 !!      
00029 !!    REFERENCE
00030 !!    ---------
00031 !!
00032 !!    
00033 !!      
00034 !!    AUTHOR
00035 !!    ------
00036 !!
00037 !!      K. Chancibault  * LTHE / Meteo-France *
00038 !!
00039 !!    MODIFICATIONS
00040 !!    -------------
00041 !!
00042 !!      Original   27/11/2006
00043 !
00044 !----------------------------------------------------------------------
00045 !*       0.      DECLARATIONS
00046 !                ------------
00047 !
00048 USE MODD_TOPODYN,       ONLY : NNCAT, NNMC, XDXT
00049 USE MODD_COUPLING_TOPD, ONLY : NMASKT
00050 USE MODD_SURF_ATM_GRID_n, ONLY : XMESH_SIZE
00051 USE MODD_SURF_PAR,        ONLY : XUNDEF, NUNDEF
00052 !
00053 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00054 USE PARKIND1  ,ONLY : JPRB
00055 !
00056 IMPLICIT NONE
00057 !
00058 !*      0.1    declarations of arguments
00059 !
00060 REAL, DIMENSION(:,:),INTENT(IN)     :: PDEF    ! deficit
00061 REAL, DIMENSION(:), INTENT(OUT)     :: PAS     !contributive area fraction in Isba meshes
00062 !
00063 !*      0.2    declarations of local variables
00064 INTEGER               :: JJ, JI
00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00066 !-----------------------------------------------------------------------
00067 IF (LHOOK) CALL DR_HOOK('SAT_AREA_FRAC',0,ZHOOK_HANDLE)
00068 !
00069 !*       0.     Initialization:
00070 ! 
00071 PAS(:)=0.0
00072 !
00073 DO JJ=1,NNCAT
00074   DO JI=1,NNMC(JJ)
00075     IF (PDEF(JJ,JI)==0.0 .AND. NMASKT(JJ,JI)/=NUNDEF) THEN 
00076       PAS(NMASKT(JJ,JI)) = PAS(NMASKT(JJ,JI)) + XDXT(JJ)**2
00077     ENDIF
00078   ENDDO
00079 ENDDO
00080 !
00081 ! Calculation of the saturated area ratio in each Isba mesh
00082 WHERE ((XMESH_SIZE/=0.).AND.(PAS/=XUNDEF))
00083   PAS(:) = PAS(:) / XMESH_SIZE(:) 
00084 ENDWHERE
00085 !
00086 IF (LHOOK) CALL DR_HOOK('SAT_AREA_FRAC',1,ZHOOK_HANDLE)
00087 !
00088 END SUBROUTINE SAT_AREA_FRAC