SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/exp_decay_soil_dif.F90
Go to the documentation of this file.
00001 !     #########################
00002 SUBROUTINE EXP_DECAY_SOIL_DIF (PF,PD_G,KWG_LAYER,PDROOT,PCONDSAT)
00003 !     ##########################################################
00004 !
00005 !!****  *EXP_DECAY_SOIL_DIF*  
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !     We caculate the hydraulic conductivity decay factor for each conductivity (for diffusion option).
00011 !     
00012 !!**  METHOD
00013 !!    ------
00014 !
00015 !     Direct calculation
00016 !
00017 !!    EXTERNAL
00018 !!    --------
00019 !
00020 !     None
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------
00024 !!
00025 !!      
00026 !!    REFERENCE
00027 !!    ---------
00028 !!      
00029 !!    AUTHOR
00030 !!    ------
00031 !!      B. Decharme     
00032 !!
00033 !!    MODIFICATIONS
00034 !!    -------------
00035 !!      Original    17/11/03 
00036 !-------------------------------------------------------------------------------
00037 !
00038 USE MODD_SGH_PAR, ONLY : X2,XF_DECAY
00039 USE MODD_SURF_PAR,ONLY : XUNDEF, NUNDEF
00040 !
00041 !*      0.1    declarations of arguments
00042 !
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 REAL, DIMENSION(:), INTENT(IN)    :: PF
00050 !                                    PF = exponential decay factor (1/m)
00051 REAL, DIMENSION(:,:),INTENT(IN   ) :: PD_G          !layer depth
00052 INTEGER, DIMENSION(:), INTENT(IN ) :: KWG_LAYER
00053 REAL, DIMENSION(:),  INTENT(IN   ) :: PDROOT        !root depth
00054 REAL, DIMENSION(:,:),INTENT(INOUT) :: PCONDSAT      !hydraulic conductivity at saturation (m s-1)
00055 !
00056 !*      0.2    declarations of local variables
00057 !
00058 REAL, DIMENSION(SIZE(PD_G(:,:),1))                   :: ZC_DEPTH
00059 REAL, DIMENSION(SIZE(PD_G(:,:),1),SIZE(PD_G(:,:),2)) :: ZD_MID
00060 !
00061 INTEGER                       :: I, INL, JL, INI
00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00063 !
00064 !-------------------------------------------------------------------------------
00065 !
00066 IF (LHOOK) CALL DR_HOOK('EXP_DECAY_SOIL_DIF',0,ZHOOK_HANDLE)
00067 !
00068 INI=SIZE(PD_G(:,:),1)
00069 INL=SIZE(PD_G(:,:),2)
00070 !
00071 !-------------------------------------------------------------------------------
00072 !
00073 !Mid point depth
00074 !
00075 ZD_MID(:,:)=XUNDEF
00076 !
00077 WHERE(PD_G(:,1)/=XUNDEF)ZD_MID(:,1)=PD_G(:,1)/X2
00078 !
00079 DO JL=2,INL
00080    DO I=1,INI
00081       IF(PD_G(I,JL)/=XUNDEF)THEN   
00082          ZD_MID(I,JL)=(PD_G(I,JL-1)+PD_G(I,JL))/X2
00083       ENDIF
00084    ENDDO
00085 ENDDO
00086 !
00087 !-------------------------------------------------------------------------------
00088 !
00089 !depth where the vertical satured hydraulic conductivities reach
00090 !the compacted value given in Clapp and Hornberger (root depth)
00091 !
00092 ZC_DEPTH=0.0
00093 !
00094 DO I=1,INI
00095    IF(PDROOT(I)/=XUNDEF.AND.KWG_LAYER(I)/=NUNDEF)THEN
00096      ZC_DEPTH(I)=PDROOT(I)
00097    ENDIF
00098 ENDDO
00099 !
00100 !-------------------------------------------------------------------------------
00101 ! Exponential conductivity of heach mid point layer 
00102 !-------------------------------------------------------------------------------
00103 !
00104 DO JL=1,INL
00105   DO I=1,INI
00106     IF(ZD_MID(I,JL)/=XUNDEF) THEN
00107       IF (JL<=KWG_LAYER(I))THEN             
00108         PCONDSAT (I,JL) = PCONDSAT (I,JL) * EXP(PF(I)*(ZC_DEPTH(I)-ZD_MID(I,JL)))
00109       ELSE
00110         PCONDSAT (I,JL) = PCONDSAT (I,KWG_LAYER(I))
00111       ENDIF
00112     ELSE
00113       PCONDSAT (I,JL) = XUNDEF
00114     ENDIF
00115   ENDDO
00116 ENDDO
00117 !
00118 !-------------------------------------------------------------------------------
00119 !
00120 IF (LHOOK) CALL DR_HOOK('EXP_DECAY_SOIL_DIF',1,ZHOOK_HANDLE)
00121 !
00122 END SUBROUTINE EXP_DECAY_SOIL_DIF
00123 
00124 
00125 
00126 
00127