Skip to content
Snippets Groups Projects
isba_meb.F90 113 KiB
Newer Older
!
!*      0.1    declarations of arguments
!
REAL, INTENT(IN)                    :: PTSTEP  
!                                      PTSTEP     = Model time step (s)
!
REAL, DIMENSION(:), INTENT(IN)      :: PLELITTERI
!                                      PLELITTERI = ice sublimation (m s-1)
REAL, DIMENSION(:), INTENT(IN)      :: PCTSFC
REAL, DIMENSION(:), INTENT(IN)      :: PLSTT
!
REAL, DIMENSION(:), INTENT(INOUT)   :: PTL, PWRL, PWRLI
!                                      PTL        = litter temperature (K)
!                                      PWRL       = litter water content (kg/m2)
!                                      PWRLI      = litter ice content (kg/m2)
REAL, DIMENSION(:,:), INTENT(IN)    :: PSOILHCAPZ
!                                      PSOILHCAPZ = soil heat capacity [J/(m3 K)]
REAL, DIMENSION(:,:), INTENT(IN)    :: PDZG
!                                      PDZG       = Layer thickness (DIF option)
REAL, DIMENSION(:), INTENT(IN)      :: PGNDLITTER
!                                      PGNDLITTER        = Litter thickness (m)
REAL, DIMENSION(:,:), INTENT(INOUT) :: PTG, PWGI, PWG
!                                      PTG        = soil temperature (K)
!                                      PWGI       = soil volumetric ice content (m3/m3)
!                                      PWG        = soil volumetric liquid water content (m3/m3)
!
INTEGER, DIMENSION(:), INTENT(IN)   :: KWG_LAYER  
!                                      KWG_LAYER = Number of soil moisture layers (DIF option)
!
REAL, DIMENSION(:), INTENT(OUT)     :: PPHASEL
!                                      PPHASEL = Phase changement in litter (W/m2)
REAL, DIMENSION(:), INTENT(OUT)     :: PLITCOR
!                                      PLITCOR = A possible ice mass correction (to be potentially    
!                                                removed from soil)  (kg/m2/s)
!
!*      0.2    declarations of local variables
!
INTEGER                             :: JL     ! loop control
!
INTEGER                             :: INL    ! Number of explicit soil layers
!
REAL, DIMENSION(SIZE(PTG,1))        :: ZEXCESS, ZK, ZHCAPL,ZELITTERI,               &
                                            ZDELTAT,ZPHASE,ZPHASEM,ZPHASEF,ZPHASEX, &
                                            ZWRL,ZWRLI,Z0,ZPHASEC
!
REAL                                :: ZPSI
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*      0.3    declaration of local parameters
!
REAL, PARAMETER                     :: ZERTOL     = 1.E-6 ! (-)     error tolerance
REAL, PARAMETER                     :: ZTAUICE    = 3300. ! (s)     litter phase change characteristic time scale
REAL, PARAMETER                     :: ZWRLSAT    = 0.85  ! (m3/m3) litter porosity
!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ICE_LITTER',0,ZHOOK_HANDLE) 
!
! Initialization:
! ---------------
!
!
INL = MAXVAL(KWG_LAYER(:))
!
ZEXCESS(:)  = 0.0
ZPHASEC(:)  = 0.0
PLITCOR (:)  = 0.0
!
ZHCAPL(:)   = 1/(PCTSFC(:)*PGNDLITTER(:))
!
!-------------------------------------------------------------------------------
!
! 1. Surface layer vegetation insulation coefficient (-)
!    ---------------------------------------------------
!
! 1.1 Convert to m3/m3
!    -----------------
!
ZWRL(:)  = PWRL(:) /(XRHOLW*PGNDLITTER(:))    
ZWRLI(:) = PWRLI(:)/(XRHOLW*PGNDLITTER(:)) 
!
! 2. Litter ice evolution computation:
!    --------------------------------
!  
ZDELTAT(:) = PTL(:) - XTT
!
!     
!     *Melt* ice if energy and ice available:
!
ZPHASEM(:)  = (PTSTEP/ZTAUICE)*MIN((XCI*XRHOLI)*MAX(0.0,ZDELTAT(:)),ZWRLI(:)*(XLMTT*XRHOLW))
!
!     *Freeze* liquid water if energy and water available and do not exceed porosity:
!
ZPHASEF(:)  = (PTSTEP/ZTAUICE)*MIN((XCI*XRHOLI)*MAX(0.0,-ZDELTAT(:)),ZWRL(:)*(XLMTT*XRHOLW))
ZPHASEF(:)  = min(ZPHASEF(:) , (ZWRLSAT - ZWRLI(:)) * (XLMTT*XRHOLW) )
!
ZPHASE(:)   = ZPHASEF(:) - ZPHASEM(:)

!     Update heat content if melting or freezing
!
PTL(:)      = PTL(:) + ZPHASE(:)/ZHCAPL(:)                                    
!
!     Get estimate of actual total phase change (J/m3) for equivalent litter water changes:

ZPHASEX(:)  = ZPHASE(:)
!
!     Adjust ice and liquid water conents (m3/m3) accordingly :
!   
ZWRL (:) = ZWRL (:) - ZPHASEX/(XLMTT*XRHOLW)
ZWRLI(:) = ZWRLI(:) + ZPHASEX/(XLMTT*XRHOLW)
!
! 2.1 Convert to Kg/m2
!    -----------------
!
PWRL(:) = ZWRL(:)  * PGNDLITTER(:) * XRHOLW
PWRLI(:)= ZWRLI(:) * PGNDLITTER(:) * XRHOLW
!
! 3. Adjust litter ice content for sublimation
!    -----------------------------------------
!
!
ZELITTERI(:) = PLELITTERI(:) * (PTSTEP/PLSTT)
ZEXCESS(:)   = MAX( 0.0 , ZELITTERI(:) - PWRLI(:) )
PLITCOR=ZEXCESS/PTSTEP
PWRLI  (:)   = PWRLI(:) - ( ZELITTERI(:) - ZEXCESS(:) )
!
! 4. Prevent some possible problems
!    ------------------------------
!
PWGI (:,1)     = PWGI(:,1)- ZEXCESS(:) / (XRHOLW * PDZG(:,1))             
!
ZEXCESS(:)     = MAX( 0.0, - PWGI(:,1) )
PWGI(:,1)      = PWGI(:,1) + ZEXCESS(:)                                
PWG (:,1)      = PWG (:,1) - ZEXCESS(:)                                
PTG (:,1)      = PTG (:,1) + ZEXCESS(:) * (XLMTT*XRHOLW)/PSOILHCAPZ(:,1) 
!
DO JL=1,INL-1                 
   ZEXCESS(:)  = MAX(0.0,-PWG(:,JL))
   PWG(:,JL+1) = PWG(:,JL+1) - ZEXCESS(:)*PDZG(:,JL)/PDZG(:,JL+1)
   PWG(:,JL)   = PWG(:,JL)   + ZEXCESS(:)
ENDDO
!
! 5. Prevent from keeping track of ice in litter
!    -------------------------------------------
!
WHERE (PWRLI(:) < ZERTOL ) 
   PWRL(:)    = PWRL(:) + PWRLI(:) 
   PTL(:)     = PTL(:)  + PWRLI(:) * XLMTT / PGNDLITTER(:) / ZHCAPL(:)
   ZPHASEC(:) = PWRLI(:) * XLMTT / PGNDLITTER(:)
   PWRLI(:)   = 0.0
ELSEWHERE
   ZPHASEC(:) = 0.0
END WHERE
!
PPHASEL(:)=(ZPHASE(:) + ZPHASEC(:))/PTSTEP*PGNDLITTER(:)
!
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:ICE_LITTER',1,ZHOOK_HANDLE) 
!
END SUBROUTINE ICE_LITTER
!===============================================================================

END SUBROUTINE ISBA_MEB