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

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     ####################
00003       SUBROUTINE TOPD_TO_ISBA_SLOPE(KI)
00004 !     ####################
00005 !
00006 !!****  *TOPD_TO_ISBA*  
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 !!      B. Vincendon    * Meteo-France *
00038 !!
00039 !!    MODIFICATIONS
00040 !!    -------------
00041 !!
00042 !!      Original   12/11/2012
00043 !-------------------------------------------------------------------------------
00044 !
00045 !*       0.     DECLARATIONS
00046 !               ------------
00047 !
00048 USE MODD_TOPODYN,       ONLY : NNCAT, NNMC, XTANB
00049 USE MODD_COUPLING_TOPD, ONLY : NMASKT,NNPIX
00050 USE MODD_SURF_ATM_SSO_n, ONLY : XSSO_SLOPE
00051 USE MODD_SURF_PAR,        ONLY : NUNDEF
00052 USE MODD_SURF_ATM_n,      ONLY : XNATURE, NSIZE_NATURE, NR_NATURE, &
00053                                  NSIZE_FULL, NDIM_NATURE, NDIM_FULL  
00054 !
00055 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00056 USE PARKIND1  ,ONLY : JPRB
00057 !
00058 IMPLICIT NONE
00059 !
00060 !*      0.1    declarations of arguments
00061 !
00062 !
00063 INTEGER, INTENT(IN)                 :: KI      ! Grid dimensions
00064 !
00065 !*      0.2    declarations of local variables
00066 !
00067 !
00068 INTEGER                :: JCAT,JPIX,JJ          ! loop control 
00069 REAL, DIMENSION(KI)    :: ZCOUNT                ! TOPO pixel number in an ISBA pixel
00070                                                 ! on the full grid
00071 REAL, DIMENSION(KI)    :: ZSSO_SLOPE
00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00073 !-------------------------------------------------------------------------------
00074 !
00075 IF (LHOOK) CALL DR_HOOK('TOPD_TO_ISBA_SLOPE',0,ZHOOK_HANDLE)
00076 !
00077 !*        1.0  Compute Mean slope over each ISBA_MESH
00078 !            ----------------------------------------------------------------------
00079 !
00080 !write(*,*) 'pente avt topmodel',MINVAL(XSSO_SLOPE),MAXVAL(XSSO_SLOPE),SUM(XSSO_SLOPE,MASK=XSSO_SLOPE/=XUNDEF)
00081 !
00082 ZSSO_SLOPE = XSSO_SLOPE
00083 !
00084 ZCOUNT(:) = REAL(NNPIX(:))
00085 
00086 WHERE (ZCOUNT /= 0.0)
00087    ZSSO_SLOPE = 0.
00088 ENDWHERE
00089 !
00090 DO JCAT=1,NNCAT
00091   DO JPIX=1,NNMC(JCAT)
00092     IF (NMASKT(JCAT,JPIX) /= NUNDEF) THEN
00093       ZSSO_SLOPE(NMASKT(JCAT,JPIX)) = ZSSO_SLOPE(NMASKT(JCAT,JPIX)) + XTANB(JCAT,JPIX)
00094     ENDIF
00095   ENDDO
00096 ENDDO
00097 !
00098 WHERE (ZCOUNT /= 0.0)
00099    ZSSO_SLOPE = ZSSO_SLOPE / ZCOUNT
00100 ENDWHERE
00101 !
00102 XSSO_SLOPE = ZSSO_SLOPE
00103 !
00104 !write(*,*) 'pente apres modification',MINVAL(XSSO_SLOPE),MAXVAL(XSSO_SLOPE),COUNT(ZCOUNT/=0.0),SUM(XSSO_SLOPE,MASK=XSSO_SLOPE/=XUNDEF)
00105 !
00106 IF (LHOOK) CALL DR_HOOK('TOPD_TO_ISBA_SLOPE',1,ZHOOK_HANDLE)
00107 !
00108 END SUBROUTINE TOPD_TO_ISBA_SLOPE