trip_oasis_recv.F90

Go to the documentation of this file.

!#########
SUBROUTINE trip_oasis_recv(TP, TPG,                           &
                           KLISTING,KLON,KLAT,PTIMEC,PRUNOFF, & 
                           PDRAIN,PCALVING,PSRC_FLOOD         )
!#############################################################################
!
!!****  *TRIP_OASIS_RECV* - Receive coupling fields
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2013
!!      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 modn_trip_oasis, ONLY : xtstep_cpl_land
!
USE modd_trip_par,  ONLY : xundef
!
USE modd_trip_oasis
!
USE modi_gw_redistrib
USE modi_flood_redistrib
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
#ifdef CPLOASIS
USE mod_oasis
#endif
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(trip_t), INTENT(INOUT) :: TP
TYPE(trip_grid_t), INTENT(INOUT) :: TPG
!
INTEGER, INTENT(IN)               :: KLISTING
INTEGER, INTENT(IN)               :: KLON
INTEGER, INTENT(IN)               :: KLAT
REAL,    INTENT(IN)               :: PTIMEC        ! Cumulated run time step (s)
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PRUNOFF       ! Surface runoff                  (kg/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PDRAIN        ! Deep drainage                   (kg/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PCALVING      ! Calving flux                    (kg/s)
REAL, DIMENSION(:,:), INTENT(OUT) :: PSRC_FLOOD    ! Input P-E-I flood source term   (kg/s)
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL,    DIMENSION(KLON,KLAT) :: ZREAD
REAL,    DIMENSION(KLON,KLAT) :: ZSRC_FLOOD
REAL,    DIMENSION(KLON,KLAT) :: ZWORK
REAL,    DIMENSION(KLON,KLAT) :: ZRESIDU
!
 CHARACTER(LEN=50)             :: YCOMMENT
INTEGER                       :: IDATE  ! current coupling time step (s)
INTEGER                       :: IERR   ! Error info
INTEGER                       :: JVAR
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
#ifdef CPLOASIS
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_OASIS_RECV',0,zhook_handle)
!
!*       1.     Initialize :
!               ------------
!
idate = int(ptimec)
!
pdrain(:,:) = 0.0
prunoff(:,:) = 0.0
pcalving(:,:) = 0.0
psrc_flood(:,:) = 0.0
!
!-------------------------------------------------------------------------------
!
!*       2.     Get coupling fields :
!               ---------------------
!
IF(lcpl_land.AND.mod(ptimec,xtstep_cpl_land)==0.0)THEN
!
! * Receive surface runoff input fields
!
  zread(:,:) = xundef  
  ycomment='Surface runoff'
  CALL oasis_get(nrunoff_id,idate,zread(:,:),ierr)
  CALL check_trip_recv(ierr,ycomment,zread,tpg%GMASK)
  CALL kgm2s_to_kgs(ierr,zread,prunoff)
!
! * Receive drainage/recharge input fields
!
  zread(:,:) = xundef  
  ycomment='Deep drainage'
  CALL oasis_get(ndrain_id,idate,zread(:,:),ierr)
  CALL check_trip_recv(ierr,ycomment,zread,tpg%GMASK)
!
  IF(lcpl_gw)THEN
!   Redistribute negative recharge flux over groundwater
!   and conserve water mass over each bassin
    zwork(:,:) = xundef
    CALL gw_redistrib(tp,tpg, &
                      klon,klat,zread,zwork)
  ELSE
    zwork(:,:) = zread(:,:)
  ENDIF
!  
  CALL kgm2s_to_kgs(ierr,zwork,pdrain)
!
! * Receive calving input fields
!
  IF(lcpl_calving)THEN
    zread(:,:) = xundef  
    ycomment='calving flux'
    CALL oasis_get(ncalving_id,idate,zread(:,:),ierr)
    CALL check_trip_recv(ierr,ycomment,zread,tpg%GMASK)
    CALL kgm2s_to_kgs(ierr,zread,pcalving)
  ENDIF
!
! * Receive floodplains input fields
!
  IF(lcpl_flood)THEN
!
    zread(:,:) = xundef 
    zsrc_flood(:,:) = xundef
    zwork(:,:) = xundef
    zresidu(:,:) = xundef
!
    ycomment='floodplains freshwater flux (P-E-I)'
    CALL oasis_get(nsrcflood_id,idate,zread(:,:),ierr)
    CALL check_trip_recv(ierr,ycomment,zread,tpg%GMASK_FLD)
!
!   Redistribute freshwater flux over flooded grid-cell
!   and conserve water mass over each bassin
    CALL flood_redistrib(tp,tpg, &
                         klon,klat,xtstep_cpl_land, &
                         zread,zsrc_flood,zwork     )
!
    CALL kgm2s_to_kgs(ierr,zsrc_flood,psrc_flood)
    CALL kgm2s_to_kgs(ierr,zwork,zresidu)
!
    WHERE(tpg%GMASK_FLD(:,:)) 
         prunoff(:,:)=prunoff(:,:)+zresidu(:,:)
    ENDWHERE
!
  ENDIF
!
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_OASIS_RECV',1,zhook_handle)
!
!-------------------------------------------------------------------------------
 CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE check_trip_recv(KERR,HCOMMENT,PFIELD,OMASK)
!
USE modi_abort_trip
!
IMPLICIT NONE
!
INTEGER,                 INTENT(IN   ) :: KERR
 CHARACTER(LEN=*),        INTENT(IN   ) :: HCOMMENT
REAL,    DIMENSION(:,:), INTENT(INOUT) :: PFIELD
LOGICAL, DIMENSION(:,:), INTENT(IN   ) :: OMASK
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('TRIP_OASIS_RECV:CHECK_TRIP_RECV',0,zhook_handle)
!
! Check receiving field 
!
IF (kerr/=oasis_ok.AND.kerr<oasis_recvd) THEN
   WRITE(klisting,'(A,I4)')'Return code from receiving '//trim(hcomment)//' : ',kerr
   CALL abort_trip('TRIP_OASIS_RECV: problem receiving '//trim(hcomment))
ENDIF
!
WHERE(.NOT.omask(:,:))
      pfield(:,:) = 0.0
ENDWHERE
!
IF (lhook) CALL dr_hook('TRIP_OASIS_RECV:CHECK_TRIP_RECV',1,zhook_handle)
!
END SUBROUTINE check_trip_recv
!
!-------------------------------------------------------------------------------
!
SUBROUTINE kgm2s_to_kgs(KERR,PIN,POUT)
!
IMPLICIT NONE
!
INTEGER,              INTENT(IN ) :: KERR
REAL, DIMENSION(:,:), INTENT(IN ) :: PIN
REAL, DIMENSION(:,:), INTENT(OUT) :: POUT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('TRIP_OASIS_RECV:KGM2S_TO_KGS',0,zhook_handle)
!
! kg/m2/s -> kg/s
!
IF(kerr>=oasis_recvd)THEN
  WHERE(tpg%GMASK(:,:)) 
        pout(:,:) = pin(:,:) * tpg%XAREA(:,:)
  ELSEWHERE
        pout(:,:) = xundef
  ENDWHERE
ELSE
  pout(:,:) = 0.0
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_OASIS_RECV:KGM2S_TO_KGS',1,zhook_handle)
!
END SUBROUTINE kgm2s_to_kgs
!
!-------------------------------------------------------------------------------
#endif
!-------------------------------------------------------------------------------
!
END SUBROUTINE trip_oasis_recv