trip_oasis_send.F90

Go to the documentation of this file.

!#########
SUBROUTINE trip_oasis_send (TP, TPG, &
                            KLISTING,KLON,KLAT,PTIMEC)
!############################################
!
!!****  *TRIP_OASIS_SEND* - Send coupling fields
!!
!!    PURPOSE
!!    -------
!!
!!    All fluxes are sent in kg/m2/s
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2013
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_trip, ONLY : trip_t
USE modd_trip_grid, ONLY : trip_grid_t
!
USE modd_trip_par,   ONLY : xundef
!
USE modn_trip_oasis, ONLY : xtstep_cpl_sea, xtstep_cpl_land
USE modd_trip_oasis
!
!
USE modi_abort_trip
!
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)
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                    :: IDATE   ! current coupling time step (s)
INTEGER                    :: IERR    ! Error info
INTEGER                    :: JVAR
 CHARACTER(LEN=50)          :: YCOMMENT
!
REAL,    DIMENSION(KLON,KLAT) :: ZWRITE
LOGICAL, DIMENSION(KLON,KLAT) :: LMASK
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
#ifdef CPLOASIS
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_OASIS_SEND',0,zhook_handle)
!
!*       1.     Define current coupling time step in second :
!               ---------------------------------------------
!
idate = int(ptimec)
!
!-------------------------------------------------------------------------------
!
!*       2.     Send coupling fields to land surface model :
!               -------------------------------------------
!
!
IF(lcpl_land.AND.mod(ptimec,xtstep_cpl_land)==0.0)THEN
!
  IF(lcpl_gw)THEN
!          
    ycomment='Water table depth' !m
    CALL oasis_put(nwtd_id,idate,tp%XCPL_WTD(:,:),ierr)
    CALL check_trip_send(ycomment)
!          
    ycomment='Grid-cell fraction of WTD to rise'
    CALL oasis_put(nfwtd_id,idate,tp%XCPL_FWTD(:,:),ierr)
    CALL check_trip_send(ycomment)
!
  ENDIF
!
  IF(lcpl_flood)THEN
!
    lmask(:,:) = tpg%GMASK(:,:)
!
    ycomment='Flood fraction' !adim
    CALL mask_trip(tp%XCPL_FFLOOD(:,:),zwrite(:,:),lmask(:,:),1.0)
    CALL oasis_put(nfflood_id,idate,zwrite(:,:),ierr)
    CALL check_trip_send(ycomment)
!          
    ycomment='Flood potential infiltration' !kg/m2/s
    CALL mask_trip(tp%XCPL_PIFLOOD(:,:),zwrite(:,:),lmask(:,:),xtstep_cpl_land)
    CALL oasis_put(npiflood_id,idate,zwrite(:,:),ierr)
    CALL check_trip_send(ycomment)
!
  ENDIF  
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.     Send coupling fields to ocean :
!               -------------------------------
!
!
IF(lcpl_sea.AND.mod(ptimec,xtstep_cpl_sea)==0.0)THEN
!
! * Sea output fields
!
  lmask(:,:) = (tpg%NGRCN(:,:)==9.OR.tpg%NGRCN(:,:)==12)
!
  ycomment='Discharge to ocean' !kg/m2/s
  CALL mask_trip(tp%XCPL_RIVDIS(:,:),zwrite(:,:),lmask(:,:),xtstep_cpl_sea)
  CALL oasis_put(nrivdis_id,idate,zwrite(:,:),ierr)
  CALL check_trip_send(ycomment)
!
! * Calving output fields
!
  IF(lcpl_calvsea)THEN
!
    lmask(:,:) = tpg%GMASK_GRE(:,:)
!
    ycomment='Calving flux over greenland' !kg/m2/s
    CALL mask_trip(tp%XCPL_CALVGRE(:,:),zwrite(:,:),lmask(:,:),xtstep_cpl_sea)
    CALL oasis_put(ncalvgre_id,idate,zwrite(:,:),ierr)
    CALL check_trip_send(ycomment)
!
    lmask(:,:) = tpg%GMASK_ANT(:,:)
!
    ycomment='Calving flux over antarctica' !kg/m2/s
    CALL mask_trip(tp%XCPL_CALVANT(:,:),zwrite(:,:),lmask(:,:),xtstep_cpl_sea)
    CALL oasis_put(ncalvant_id,idate,zwrite(:,:),ierr)
    CALL check_trip_send(ycomment)
!
  ENDIF
!
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_OASIS_SEND',1,zhook_handle)
!
!-------------------------------------------------------------------------------
 CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE check_trip_send(HCOMMENT)
!
USE modi_abort_trip
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('TRIP_OASIS_SEND:CHECK_TRIP_SEND',0,zhook_handle)
!
! Check receiving field 
!
IF (ierr/=oasis_ok.AND.ierr<oasis_sent) THEN
   WRITE(klisting,'(A,I4)')'Return code from sending '//trim(hcomment)//' : ',ierr
   CALL abort_trip('TRIP_OASIS_SEND: problem sending '//trim(hcomment))
ENDIF
!
IF (lhook) CALL dr_hook('TRIP_OASIS_SEND:CHECK_TRIP_SEND',1,zhook_handle)
!
END SUBROUTINE check_trip_send
!
!-------------------------------------------------------------------------------
!
SUBROUTINE mask_trip(PIN,POUT,OMASK,PDIV)
!
IMPLICIT NONE
!
REAL,    DIMENSION(:,:), INTENT(INOUT) :: PIN
REAL,    DIMENSION(:,:), INTENT(OUT  ) :: POUT
LOGICAL, DIMENSION(:,:), INTENT(IN   ) :: OMASK
REAL                   , INTENT(IN   ) :: PDIV
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('TRIP_OASIS_SEND:MASK_TRIP',0,zhook_handle)
!
pout(:,:) = xundef
!
WHERE(omask(:,:)) 
      pout(:,:) = pin(:,:)/pdiv
      pin(:,:) = 0.0     
ELSEWHERE
      pin(:,:) = xundef    
ENDWHERE
!
IF (lhook) CALL dr_hook('TRIP_OASIS_SEND:MASK_TRIP',1,zhook_handle)
!
END SUBROUTINE mask_trip
!
!
!-------------------------------------------------------------------------------
#endif
!-------------------------------------------------------------------------------
!
END SUBROUTINE trip_oasis_send