init_trip_cpl_esm.F90

Go to the documentation of this file.

SUBROUTINE init_trip_cpl_esm (TP, TPG, &
                              KLON,KLAT)  
!     ##################################
!
!!****  *INIT_TRIP_CPL_ESM*  
!!
!!    PURPOSE
!!    -------
!
!     TRIP cpl diag compuation
!     
!!      
!!    AUTHOR
!!    ------
!!      B. Decharme
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    12/12/13 
!!      B. Decharme 10/2016  bug surface/groundwater coupling   
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE modd_trip,      ONLY : trip_t
USE modd_trip_grid, ONLY : trip_grid_t
!
USE modd_trip_oasis, ONLY : lcpl_sea, lcpl_land, lcpl_gw,    &
                            lcpl_flood, lcpl_calvsea
!
USE modd_trip_par,  ONLY : xundef
!
USE mode_trip_grid
!
USE modi_trip_nearest
!
USE modi_gwf_cpl_update
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(trip_t), INTENT(INOUT) :: TP
TYPE(trip_grid_t), INTENT(INOUT) :: TPG
!
INTEGER, INTENT(IN) :: KLON
INTEGER, INTENT(IN) :: KLAT
!
!*      0.2    declarations of local variables
!
REAL,   DIMENSION(KLON,KLAT) :: ZHG_OLD    !Water table elevation at t-1    [m]
REAL,   DIMENSION(KLON,KLAT) :: ZWTD       !Water table depth               [m]
REAL,   DIMENSION(KLON,KLAT) :: ZFWTD      !Fraction of Water table to rise
!
INTEGER,DIMENSION(KLON*KLAT) :: ICODE
REAL,   DIMENSION(KLON*KLAT) :: ZNEAR
REAL,   DIMENSION(KLON*KLAT) :: ZX
REAL,   DIMENSION(KLON*KLAT) :: ZY
REAL,   DIMENSION(KLON)      :: ZLON
REAL,   DIMENSION(KLAT)      :: ZLAT
!
INTEGER                      :: IWORK, JLON, JLAT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('INIT_TRIP_CPL_ESM',0,zhook_handle)
!
zhg_old(:,:) = xundef
zwtd(:,:) = xundef
zfwtd(:,:) = xundef
!
!-------------------------------------------------------------------------------
! * Allocate coupling variables
!-------------------------------------------------------------------------------
!
IF(lcpl_sea)THEN
  ALLOCATE(tp%XCPL_RIVDIS(klon,klat))
  tp%XCPL_RIVDIS(:,:) = xundef
ELSE
  ALLOCATE(tp%XCPL_RIVDIS(0,0))
ENDIF
!
IF(lcpl_calvsea)THEN
  ALLOCATE(tp%XCPL_CALVGRE(klon,klat))
  ALLOCATE(tp%XCPL_CALVANT(klon,klat))
  tp%XCPL_CALVGRE(:,:) = xundef
  tp%XCPL_CALVANT(:,:) = xundef
ELSE
  ALLOCATE(tp%XCPL_CALVGRE(0,0))
  ALLOCATE(tp%XCPL_CALVANT(0,0))
ENDIF
!
IF(lcpl_land)THEN
  IF(lcpl_gw)THEN
    ALLOCATE(tp%XCPL_FWTD (klon,klat))
    ALLOCATE(tp%XCPL_WTD  (klon,klat))
    ALLOCATE(tp%XNEAR_AQUI(klon,klat))
    tp%XCPL_FWTD (:,:) = xundef
    tp%XCPL_WTD  (:,:) = xundef
    tp%XNEAR_AQUI(:,:) = xundef
  ELSE
    ALLOCATE(tp%XCPL_FWTD (0,0))
    ALLOCATE(tp%XCPL_WTD  (0,0))
    ALLOCATE(tp%XNEAR_AQUI(0,0))
  ENDIF
  IF(lcpl_flood)THEN
    ALLOCATE(tp%XCPL_FFLOOD (klon,klat))
    ALLOCATE(tp%XCPL_PIFLOOD(klon,klat))
    tp%XCPL_FFLOOD (:,:) = xundef
    tp%XCPL_PIFLOOD(:,:) = xundef
  ELSE
    ALLOCATE(tp%XCPL_FFLOOD (0,0))
    ALLOCATE(tp%XCPL_PIFLOOD(0,0))
  ENDIF
ELSE
  ALLOCATE(tp%XCPL_FFLOOD (0,0))
  ALLOCATE(tp%XCPL_PIFLOOD(0,0))
  ALLOCATE(tp%XCPL_FWTD   (0,0))
  ALLOCATE(tp%XCPL_WTD    (0,0))
  ALLOCATE(tp%XNEAR_AQUI  (0,0))
ENDIF
!
!-------------------------------------------------------------------------------
! * Actualisation of coupling diagnostic:
!-------------------------------------------------------------------------------
!
IF(lcpl_sea)THEN
  WHERE(tpg%NGRCN(:,:)==9.OR.tpg%NGRCN(:,:)==12)
    tp%XCPL_RIVDIS(:,:) = 0.0
  ENDWHERE 
ENDIF
!
IF(lcpl_calvsea)THEN
  WHERE(tpg%GMASK_GRE(:,:))
    tp%XCPL_CALVGRE(:,:) = 0.0
  ENDWHERE 
  WHERE(tpg%GMASK_ANT(:,:))
    tp%XCPL_CALVANT(:,:) = 0.0
  ENDWHERE 
ENDIF
!
IF(lcpl_land)THEN
!
  IF(lcpl_gw)THEN
!
!   Water table depth and fraction of water table to rise
!
    CALL gwf_cpl_update(tp%XTABGW_H,tp%XTABGW_F,tpg%GMASK_GW,&
                        tp%XTOPO_RIV,tp%XHC_BED,tp%XHGROUND, &
                        zhg_old,zwtd,zfwtd                   )
!
    WHERE(tpg%GMASK_GW(:,:))
          tp%XCPL_WTD (:,:) = zwtd(:,:)
          tp%XCPL_FWTD(:,:) = zfwtd(:,:)
    ELSEWHERE(tpg%GMASK(:,:))
          tp%XCPL_WTD (:,:) = xundef
          tp%XCPL_FWTD(:,:) = 0.0          
    ENDWHERE
!
!   Find nearest aquifer
!    
    CALL get_trip_grid(tpg%XTRIP_GRID,plon=zlon,plat=zlat)
!
    znear(:)=xundef
    icode(:)=-1    
!
    iwork=0
    DO jlat=1,klat
       DO jlon=1,klon 
          IF(tpg%GMASK(jlon,jlat))THEN
            iwork=iwork+1
            icode(iwork)=0
            zx(iwork)=zlon(jlon)
            zy(iwork)=zlat(jlat)
            znear(iwork)=tp%XNUM_AQUI(jlon,jlat)
            IF(tpg%GMASK_GW(jlon,jlat))icode(iwork)=1
          ENDIF
       ENDDO
    ENDDO
!
    CALL trip_nearest(iwork,icode(1:iwork),zx(1:iwork),zy(1:iwork),znear(1:iwork))
!
    iwork=0
    DO jlat=1,klat
       DO jlon=1,klon
          IF(tpg%GMASK(jlon,jlat))THEN          
            iwork=iwork+1
            tp%XNEAR_AQUI(jlon,jlat)=znear(iwork)
          ENDIF
       ENDDO
    ENDDO
!
  ENDIF
!
! Flood fraction [-] and potential infiltration [kg/m2]
! no flood for very smal flooded area (<0.1% of grid-cell)
!       
  IF(lcpl_flood)THEN
     tp%XCPL_FFLOOD (:,:) = tp%XFFLOOD    (:,:)
     tp%XCPL_PIFLOOD(:,:) = tp%XFLOOD_STO (:,:) / tpg%XAREA(:,:)             
  ENDIF
!  
ENDIF
!
IF (lhook) CALL dr_hook('INIT_TRIP_CPL_ESM',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE init_trip_cpl_esm