SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/dif

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE DIF_LAYER(KLU, KGROUND_LAYER, KPATCH, KSIZE_NATURE_P, &
00003                      PPATCH, PDG, PDROOT, PDG2, PROOTFRAC,       &
00004                      KWG_LAYER, PDZG, PDZDIF, PSOILWGHT,         &
00005                      PRUNOFFD, KLAYER_HORT, KLAYER_DUN           )  
00006 !#############################################################
00007 !
00008 !!****  *DIF_LAYER_n* - routine to initialize dif numbers of layers
00009 !!
00010 !!    PURPOSE
00011 !!    -------
00012 !!
00013 !!**  METHOD
00014 !!    ------
00015 !!
00016 !!    EXTERNAL
00017 !!    --------
00018 !!
00019 !!
00020 !!    IMPLICIT ARGUMENTS
00021 !!    ------------------
00022 !!
00023 !!    REFERENCE
00024 !!    ---------
00025 !!
00026 !!
00027 !!    AUTHOR
00028 !!    ------
00029 !!    S. Faroux
00030 !!
00031 !!    MODIFICATIONS
00032 !!    -------------
00033 !!      Original    02/2012!!
00034 !-------------------------------------------------------------------------------
00035 !
00036 !*       0.    DECLARATIONS
00037 !              ------------
00038 !
00039 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
00040 USE MODD_SGH_PAR,        ONLY : XHORT_DEPTH
00041 !
00042 USE MODI_ABOR1_SFX
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*       0.1   Declarations of arguments
00050 !              -------------------------
00051 !
00052 INTEGER, INTENT(IN) :: KLU
00053 INTEGER, INTENT(IN) :: KGROUND_LAYER
00054 INTEGER, INTENT(IN) :: KPATCH
00055 INTEGER, DIMENSION(:),  INTENT(IN) :: KSIZE_NATURE_P
00056 REAL, DIMENSION(:,:),   INTENT(IN) :: PPATCH
00057 REAL, DIMENSION(:,:,:), INTENT(IN) :: PDG
00058 REAL, DIMENSION(:,:),   INTENT(IN) :: PDROOT
00059 REAL, DIMENSION(:,:),   INTENT(IN) :: PDG2
00060 REAL, DIMENSION(:,:,:), INTENT(IN) :: PROOTFRAC
00061 INTEGER, DIMENSION(:,:),INTENT(IN) :: KWG_LAYER
00062 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZG
00063 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZDIF
00064 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSOILWGHT
00065 REAL, DIMENSION(:,:),   INTENT(OUT) :: PRUNOFFD
00066 INTEGER, INTENT(OUT) :: KLAYER_HORT
00067 INTEGER, INTENT(OUT) :: KLAYER_DUN
00068 !
00069 !*       0.2   Declarations of local variables
00070 !              -------------------------------
00071 !
00072 REAL, DIMENSION(KLU) :: ZWORK
00073 INTEGER, DIMENSION(KLU,KPATCH) :: IWORK
00074 INTEGER :: JLAYER, JPATCH, JILU, IDEPTH
00075 !
00076 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00077 !
00078 !-------------------------------------------------------------------------------
00079 !
00080 !               Initialisation for IO
00081 !
00082 IF (LHOOK) CALL DR_HOOK('DIF_LAYER',0,ZHOOK_HANDLE)
00083 !
00084 DO JLAYER = 1, KGROUND_LAYER
00085   IF (ANY((PROOTFRAC(:,JLAYER,:)<0. .OR. PROOTFRAC(:,JLAYER,:)>1.) .AND. PPATCH(:,:).NE.0.)) &
00086     CALL ABOR1_SFX('DIF_LAYER: WITH CISBA=DIF ROOTFRAC MUST BE DEFINED')
00087 ENDDO
00088 !
00089 PDZG     (:,:,:) = XUNDEF
00090 PDZDIF   (:,:,:) = XUNDEF
00091 PSOILWGHT(:,:,:) = 0.0
00092 !
00093 DO JPATCH=1,KPATCH
00094 !
00095   IF (KSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
00096 !
00097 !*   soil layers thicknesses
00098   PDZG(:,1,JPATCH) = PDG(:,1,JPATCH)
00099   DO JLAYER=2,KGROUND_LAYER
00100     DO JILU=1,KLU
00101       PDZG(JILU,JLAYER,JPATCH) = PDG(JILU,JLAYER,JPATCH) - PDG(JILU,JLAYER-1,JPATCH)
00102     ENDDO
00103   ENDDO
00104 !
00105 !*   distance between consecuative layer mid-points
00106   DO JLAYER=1,KGROUND_LAYER
00107     DO JILU=1,KLU
00108       IF(JLAYER<KGROUND_LAYER)THEN
00109         PDZDIF(JILU,JLAYER,JPATCH)=0.5*(PDZG(JILU,JLAYER,JPATCH)+PDZG(JILU,JLAYER+1,JPATCH))
00110       ELSE
00111         PDZDIF(JILU,JLAYER,JPATCH)=0.5*PDZG(JILU,JLAYER,JPATCH) 
00112       ENDIF
00113     ENDDO
00114   ENDDO 
00115 ! 
00116 ENDDO
00117 !
00118 ! Horton runoff parameter
00119 !
00120 IWORK(:,:) = KWG_LAYER(:,:)
00121 !
00122 DO JPATCH=1,KPATCH
00123 !  
00124   IF( KSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
00125 !
00126   DO JILU=1,KLU
00127     IDEPTH = KWG_LAYER(JILU,JPATCH)
00128     IF (IDEPTH==NUNDEF) IDEPTH = KGROUND_LAYER
00129     DO JLAYER=1,IDEPTH-1
00130       IF(PDG(JILU,JLAYER,JPATCH)<XHORT_DEPTH) IWORK(JILU,JPATCH)=JLAYER+1
00131     ENDDO
00132   ENDDO
00133 !
00134 END DO
00135 !  
00136 KLAYER_HORT=MAXVAL(IWORK(:,:),IWORK(:,:)/=NUNDEF)
00137 !  
00138 ! Dunne runoff parameter
00139 !
00140 IWORK(:,:)=KWG_LAYER(:,:)
00141 !
00142 DO JPATCH=1,KPATCH
00143 !  
00144   IF (KSIZE_NATURE_P(JPATCH) == 0 ) CYCLE
00145 !
00146   DO JILU=1,KLU
00147     IF(PPATCH(JILU,JPATCH)>0.0)THEN 
00148       IDEPTH = KWG_LAYER(JILU,JPATCH)    
00149       IF(PDROOT(JILU,JPATCH)>0.0.AND.PDROOT(JILU,JPATCH)/=XUNDEF)THEN
00150         PRUNOFFD(JILU,JPATCH) = PDG(JILU,1,JPATCH)
00151         DO JLAYER=1,IDEPTH-1
00152           IF(PROOTFRAC(JILU,JLAYER,JPATCH)<0.90)THEN
00153             PRUNOFFD(JILU,JPATCH) = PDG(JILU,JLAYER+1,JPATCH)
00154           ENDIF
00155         ENDDO
00156       ELSE
00157         PRUNOFFD(JILU,JPATCH) = MIN(0.6,PDG2(JILU,JPATCH))
00158       ENDIF
00159     ENDIF
00160   ENDDO
00161 !
00162   ZWORK(:) = 0.0
00163   DO JLAYER=1,KGROUND_LAYER
00164     DO JILU=1,KLU
00165       IF(PPATCH(JILU,JPATCH)>0.0)THEN
00166         IDEPTH=KWG_LAYER(JILU,JPATCH)
00167         IF(JLAYER<=IDEPTH)THEN
00168           ZWORK    (JILU              ) = ZWORK(JILU) + PDZG(JILU,JLAYER,JPATCH)  
00169           PSOILWGHT(JILU,JLAYER,JPATCH) = MIN(PDZG(JILU,JLAYER,JPATCH), &
00170                                           MAX(0.0,PRUNOFFD(JILU,JPATCH)-ZWORK(JILU)+PDZG(JILU,JLAYER,JPATCH)))
00171         ENDIF
00172         IF(PDG(JILU,JLAYER,JPATCH)<PRUNOFFD(JILU,JPATCH))THEN
00173           IWORK(JILU,JPATCH)=JLAYER+1
00174         ENDIF
00175       ENDIF
00176     ENDDO
00177   ENDDO
00178 !  
00179 END DO
00180 !
00181 KLAYER_DUN=MAXVAL(IWORK(:,:),IWORK(:,:)/=NUNDEF)
00182 !
00183 IF (LHOOK) CALL DR_HOOK('DIF_LAYER',1,ZHOOK_HANDLE)
00184 !
00185 END SUBROUTINE DIF_LAYER