trip_oasis_prep.F90

Go to the documentation of this file.

!#########
SUBROUTINE trip_oasis_prep (TPG, &
                            KLISTING,KLON,KLAT)
!###############################################
!
!!****  *TRIP_OASIS_PREP* - Definitions for exchange of 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_grid, ONLY : trip_grid_t
!
USE modn_trip_oasis
USE modd_trip_oasis
!
USE modd_trip_par, ONLY : nundef
!
USE modd_trip_oasis
!
USE mode_trip_grid
!
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_grid_t), INTENT(INOUT) :: TPG
!
INTEGER, INTENT(IN)    :: KLISTING 
INTEGER, INTENT(IN)    :: KLON
INTEGER, INTENT(IN)    :: KLAT
!
!*       0.2   Declarations of local parameter
!              -------------------------------
!
INTEGER,               PARAMETER  :: INCORNER     = 4       ! Number of grid-cell corners
INTEGER,               PARAMETER  :: IG_PARSIZE   = 3       ! Size of array decomposition
INTEGER,               PARAMETER  :: IG_NSEGMENTS = 1       ! Number of segments of process decomposition
INTEGER, DIMENSION(2), PARAMETER  :: IVAR_NODIMS  = (/2,1/) ! rank and number of bundles in coupling field
!
 CHARACTER(LEN=4)                  :: YCPL_LAND = 'tlan'
 CHARACTER(LEN=4)                  :: YCPL_GW   = 'tgw '
 CHARACTER(LEN=4)                  :: YCPL_FLD  = 'tfld'
 CHARACTER(LEN=4)                  :: YCPL_SEA  = 'tsea'
 CHARACTER(LEN=4)                  :: YCPL_GRE  = 'tgre'
 CHARACTER(LEN=4)                  :: YCPL_ANT  = 'tant'
!
!*       0.3   Declarations of local variables
!              -------------------------------
!
REAL                                    :: ZRES
REAL,    DIMENSION(KLON)                :: ZLON1D
REAL,    DIMENSION(KLAT)                :: ZLAT1D
REAL,    DIMENSION(KLON,KLAT)           :: ZLON
REAL,    DIMENSION(KLON,KLAT)           :: ZLAT
REAL,    DIMENSION(KLON,KLAT)           :: ZAREA
INTEGER, DIMENSION(KLON,KLAT)           :: IMASK
!
REAL,    DIMENSION(KLON,KLAT,INCORNER)  :: ZCORNER_LON
REAL,    DIMENSION(KLON,KLAT,INCORNER)  :: ZCORNER_LAT
!
INTEGER, DIMENSION(IG_PARSIZE) :: IPARAL      ! Decomposition for each proc
INTEGER, DIMENSION(2,2)        :: IVAR_SHAPE  ! indexes for the coupling field local dimension
!
INTEGER                        :: IPART_ID ! Local partition ID
INTEGER                        :: IERR     ! Error info
!
LOGICAL                        :: GFOUND   ! Return code when searching namelist
INTEGER                        :: INAM     ! logical unit of namelist file
!
INTEGER                        :: JLON, JLAT, JC, IFLAG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_OASIS_PREP',0,zhook_handle)
!
!-------------------------------------------------------------------------------
#ifdef CPLOASIS
!-------------------------------------------------------------------------------
!
!*       1.     Grid definition :
!               -----------------
!
 CALL get_trip_grid(tpg%XTRIP_GRID,pres=zres,plon=zlon1d,plat=zlat1d)
!
zres = zres / 2.0
!
!     4_______3
!     |       |
!     |   .   |
!     |       |
!     |_______|
!     1       2
!
DO jlon=1,klon
  DO jlat=1,klat
!
!    grid cell center
!
     zlon(jlon,jlat)=zlon1d(jlon)
     zlat(jlon,jlat)=zlat1d(jlat)
!
!    grid cell corner (counterclockwise sense)
!
     zcorner_lon(jlon,jlat,1) = zlon1d(jlon) - zres
     zcorner_lat(jlon,jlat,1) = zlat1d(jlat) - zres
!     
     zcorner_lon(jlon,jlat,3) = zlon1d(jlon) + zres
     zcorner_lat(jlon,jlat,3) = zlat1d(jlat) + zres
!
  ENDDO
ENDDO
!     
zcorner_lon(:,:,4) = zcorner_lon(:,:,1)
zcorner_lat(:,:,4) = zcorner_lat(:,:,3)
!  
zcorner_lon(:,:,2) = zcorner_lon(:,:,3)
zcorner_lat(:,:,2) = zcorner_lat(:,:,1)
!
 CALL oasis_start_grids_writing(iflag)
!
!
!*       1.1    Grid definition for Land surface :
!               ----------------------------------
!
IF(lcpl_land)THEN
!
! 0 = not masked ; 1 = masked
  WHERE(tpg%GMASK(:,:))
    imask(:,:) = 0
  ELSEWHERE
    imask(:,:) = 1
  ENDWHERE
!
  zarea(:,:) = tpg%XAREA(:,:) * (1.0-imask(:,:))
!
  CALL oasis_write_grid  (ycpl_land,klon,klat,zlon(:,:),zlat(:,:))
  CALL oasis_write_corner(ycpl_land,klon,klat,incorner,zcorner_lon(:,:,:),zcorner_lat(:,:,:))
  CALL oasis_write_area  (ycpl_land,klon,klat,zarea(:,:))
  CALL oasis_write_mask  (ycpl_land,klon,klat,imask(:,:))
!
ENDIF
!
! groundwater surface coupling case
!
IF(lcpl_gw)THEN
!
! 0 = not masked ; 1 = masked
  WHERE(tpg%GMASK_GW(:,:))
    imask(:,:) = 0
  ELSEWHERE
    imask(:,:) = 1
  ENDWHERE
!
  zarea(:,:) = tpg%XAREA(:,:) * (1.0-imask(:,:))
!
  CALL oasis_write_grid  (ycpl_gw,klon,klat,zlon(:,:),zlat(:,:))
  CALL oasis_write_corner(ycpl_gw,klon,klat,incorner,zcorner_lon(:,:,:),zcorner_lat(:,:,:))
  CALL oasis_write_area  (ycpl_gw,klon,klat,zarea(:,:))
  CALL oasis_write_mask  (ycpl_gw,klon,klat,imask(:,:))
!
ENDIF
!
! Floodplains surface coupling case
!
IF(lcpl_flood)THEN
!
! 0 = not masked ; 1 = masked
  WHERE(tpg%GMASK_FLD(:,:))
    imask(:,:) = 0
  ELSEWHERE
    imask(:,:) = 1
  ENDWHERE
!
  zarea(:,:) = tpg%XAREA(:,:) * (1.0-imask(:,:))
!
  CALL oasis_write_grid  (ycpl_fld,klon,klat,zlon(:,:),zlat(:,:))
  CALL oasis_write_corner(ycpl_fld,klon,klat,incorner,zcorner_lon(:,:,:),zcorner_lat(:,:,:))
  CALL oasis_write_area  (ycpl_fld,klon,klat,zarea(:,:))
  CALL oasis_write_mask  (ycpl_fld,klon,klat,imask(:,:))
!
ENDIF
!
!*       1.2    Grid definition for sea :
!               -------------------------
!
IF(lcpl_sea)THEN
!
! 0 = not masked ; 1 = masked
  WHERE(tpg%NGRCN(:,:)==9.OR.tpg%NGRCN(:,:)==12)
    imask(:,:) = 0
  ELSEWHERE
    imask(:,:) = 1
  ENDWHERE
!
  zarea(:,:) = tpg%XAREA(:,:) * (1.0-imask(:,:))
!
  CALL oasis_write_grid  (ycpl_sea,klon,klat,zlon(:,:),zlat(:,:))
  CALL oasis_write_corner(ycpl_sea,klon,klat,incorner,zcorner_lon(:,:,:),zcorner_lat(:,:,:))
  CALL oasis_write_area  (ycpl_sea,klon,klat,zarea(:,:))
  CALL oasis_write_mask  (ycpl_sea,klon,klat,imask(:,:))
!
ENDIF
!
!*       1.3    Grid definition for calving flux :
!               ----------------------------------
!
IF(lcpl_calvsea)THEN
!
!* Over Greenland
!
! 0 = not masked ; 1 = masked
  WHERE(tpg%GMASK_GRE(:,:))
    imask(:,:) = 0
  ELSEWHERE
    imask(:,:) = 1
  ENDWHERE
!
  zarea(:,:) = tpg%XAREA(:,:) * (1.0-imask(:,:))
!
  CALL oasis_write_grid  (ycpl_gre,klon,klat,zlon(:,:),zlat(:,:))
  CALL oasis_write_corner(ycpl_gre,klon,klat,incorner,zcorner_lon(:,:,:),zcorner_lat(:,:,:))
  CALL oasis_write_area  (ycpl_gre,klon,klat,zarea(:,:))
  CALL oasis_write_mask  (ycpl_gre,klon,klat,imask(:,:))
!
!* Over Antarctica
!
! 0 = not masked ; 1 = masked
  WHERE(tpg%GMASK_ANT(:,:))
    imask(:,:) = 0
  ELSEWHERE
    imask(:,:) = 1
  ENDWHERE
!
  zarea(:,:) = tpg%XAREA(:,:) * (1.0-imask(:,:))
!
  CALL oasis_write_grid  (ycpl_ant,klon,klat,zlon(:,:),zlat(:,:))
  CALL oasis_write_corner(ycpl_ant,klon,klat,incorner,zcorner_lon(:,:,:),zcorner_lat(:,:,:))
  CALL oasis_write_area  (ycpl_ant,klon,klat,zarea(:,:))
  CALL oasis_write_mask  (ycpl_ant,klon,klat,imask(:,:))
!
ENDIF
!
 CALL oasis_terminate_grids_writing()
!
 CALL oasis_enddef(ierr)
!
IF(ierr/=oasis_ok)THEN
   WRITE(klisting,*)'TRIP_OASIS_PREP: OASIS enddef problem, err = ',ierr
   CALL abort_trip('TRIP_OASIS_PREP: OASIS enddef problem')
ENDIF
!
!-------------------------------------------------------------------------------
#endif
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('TRIP_OASIS_PREP',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE trip_oasis_prep