trip_update_and_conserv.F90

Go to the documentation of this file.

!     #########
      SUBROUTINE trip_update_and_conserv(OPRINT,OFLOOD,HGROUNDW,PAREA,PWEFF,   &
                                         PSURF_STO2,PFLOOD_STO2,PGROUND_STO2,  &
                                         PSURF_STO,PFLOOD_STO,PGROUND_STO,     &
                                         OMASK_GW,PHGROUND,PRECUP_ALL          )  
!     ################################################################
!
!!****  *TRIP_UPDATE_AND_CONSERV*  
!!
!!    PURPOSE
!!    -------
!
! Update all reservoir and conserve water mass as possible
!     
!!**  METHOD
!!    ------
!
!     Direct calculation
!
!!    EXTERNAL
!!    --------
!
!     None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      B. Decharme
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/12/13 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modn_trip,     ONLY : xcvel
USE modd_trip_par, ONLY : xrholw
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
LOGICAL,                 INTENT(IN)    :: OPRINT   !Printable budget key 
LOGICAL,                 INTENT(IN)    :: OFLOOD       !Flood scheme key
 CHARACTER(LEN=3),        INTENT(IN)    :: HGROUNDW     !Groundwater scheme key
LOGICAL, DIMENSION(:,:), INTENT(IN)    :: OMASK_GW     !Groundwater mask
REAL,    DIMENSION(:,:), INTENT(IN)    :: PAREA        ! Grid-cell area                  [m2]
REAL,    DIMENSION(:,:), INTENT(IN)    :: PWEFF        ! Effective porosity              [-]
REAL,    DIMENSION(:,:), INTENT(IN)    :: PSURF_STO2   ! river channel storage           [kg]
REAL,    DIMENSION(:,:), INTENT(IN)    :: PFLOOD_STO2  ! Floodplain water storage        [kg]
REAL,    DIMENSION(:,:), INTENT(IN)    :: PGROUND_STO2 ! groundwater storage             [kg]
!
REAL,    DIMENSION(:,:), INTENT(OUT)   :: PSURF_STO    ! river channel storage at t+1    [kg]
REAL,    DIMENSION(:,:), INTENT(OUT)   :: PFLOOD_STO   ! Floodplain water storage at t+1 [kg]
REAL,    DIMENSION(:,:), INTENT(OUT)   :: PGROUND_STO  ! groundwater storage at t+1      [kg]
REAL,    DIMENSION(:,:), INTENT(INOUT) :: PHGROUND     ! water table elevation           [m]
REAL,                    INTENT(OUT)   :: PRECUP_ALL   ! Global none conserved water mass[kg/m2]
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PAREA,1),SIZE(PAREA,2)) :: ZRECUP_FLD  ! ensure water conservation        [kg]    
REAL, DIMENSION(SIZE(PAREA,1),SIZE(PAREA,2)) :: ZRECUP_SURF ! ensure water conservation        [kg]    
REAL, DIMENSION(SIZE(PAREA,1),SIZE(PAREA,2)) :: ZRECUP_FINAL! ensure water conservation        [kg]    
!
INTEGER :: ILON, ILAT, JLON, JLAT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_UPDATE_AND_CONSERV',0,zhook_handle)
!
!-------------------------------------------------------------------------------
! * Init
!-------------------------------------------------------------------------------
!
ilon = SIZE(parea,1)
ilat = SIZE(parea,2)
!
zrecup_fld(:,:) = 0.0
zrecup_surf(:,:) = 0.0
zrecup_final(:,:) = 0.0
!
!-------------------------------------------------------------------------------
! * Update and conserve water mass
!-------------------------------------------------------------------------------
!
IF(oflood)THEN
   zrecup_fld(:,:) = min(0.0,pflood_sto2(:,:)) 
   pflood_sto(:,:) = max(0.0,pflood_sto2(:,:))
ENDIF
!
zrecup_surf(:,:) = min(0.0,psurf_sto2(:,:)+zrecup_fld(:,:))
psurf_sto(:,:) = max(0.0,psurf_sto2(:,:)+zrecup_fld(:,:))
!
IF(hgroundw=='CST')THEN
!        
  WHERE(omask_gw(:,:)) 
       zrecup_final(:,:) = min(0.0,pground_sto2(:,:)+zrecup_surf(:,:))
       pground_sto(:,:) = max(0.0,pground_sto2(:,:)+zrecup_surf(:,:))
  ELSEWHERE
       zrecup_final(:,:) = zrecup_surf(:,:)
       pground_sto(:,:) = 0.0
  ENDWHERE
!  
ELSEIF(hgroundw=='DIF')THEN
!
  WHERE(omask_gw(:,:).AND.zrecup_surf(:,:)<0.0)
       zrecup_final(:,:) = 0.0
       phground(:,:) = phground(:,:)+zrecup_surf(:,:)/(pweff(:,:)*parea(:,:)*xrholw)
  ELSEWHERE
       zrecup_final(:,:) = zrecup_surf(:,:)
  ENDWHERE
!  
ELSE
!        
  zrecup_final(:,:) = zrecup_surf(:,:)
!  
ENDIF
!
!-------------------------------------------------------------------------------
! * Global unconserved water mass calculation
!-------------------------------------------------------------------------------
!
IF(oprint)THEN
!
  precup_all = 0.0
!
  DO jlat=1,ilat
     DO jlon=1,ilon
        precup_all = precup_all + zrecup_final(jlon,jlat)/parea(jlon,jlat)
     ENDDO
  ENDDO   
!
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_UPDATE_AND_CONSERV',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
END SUBROUTINE trip_update_and_conserv