module map_iceocn_mct 3,4
!---------------------------------------------------------------------
!
! Purpose:
!
! Collect coupling routines for sequential coupling of ICE-OCN.
!
! Author: R. Jacob, M. Vertenstein
!
!---------------------------------------------------------------------
use shr_sys_mod
use mct_mod
use seq_cdata_mod
use seq_comm_mct
implicit none
save
private ! except
!--------------------------------------------------------------------------
! Public interfaces
!--------------------------------------------------------------------------
public :: map_ice2ocn_init_mct
public :: map_ocn2ice_init_mct
public :: map_ice2ocn_mct
public :: map_ocn2ice_mct
!--------------------------------------------------------------------------
! Public data
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! Private data
!--------------------------------------------------------------------------
type(mct_rearr), private :: Re_ice2ocn
type(mct_rearr), private :: Re_ocn2ice
#ifdef CPP_VECTOR
logical :: usevector = .true.
#else
logical :: usevector = .false.
#endif
#ifdef SYSUNICOS
logical :: usealltoall = .true.
#else
logical :: usealltoall = .false.
#endif
character(*),parameter :: subName = '(map_iceocn_mct)'
!=======================================================================
contains
!=======================================================================
subroutine map_ocn2ice_init_mct( cdata_o, cdata_i) 1,4
!-----------------------------------------------------
!
! Arguments
!
type(seq_cdata),intent(in) :: cdata_o
type(seq_cdata),intent(in) :: cdata_i
!
! Local Variables
!
integer :: ka, km ! indices
integer :: ocnsize, icesize ! global grid sizes
type(mct_gsMap), pointer :: gsMap_i ! ice gsMap
type(mct_gsMap), pointer :: gsMap_o ! ocn gsMap
type(mct_gGrid), pointer :: dom_i ! ice domain
type(mct_gGrid), pointer :: dom_o ! ocn domain
integer :: mpicom ! communicator spanning ocn and ice
integer :: lsize ! size of attribute vector
type(mct_aVect) :: areasrc ! ocn areas from mapping file
type(mct_aVect) :: areadst ! ice areas from mapping file
!-----------------------------------------------------
call seq_cdata_setptrs
(cdata_o, gsMap=gsMap_o, dom=dom_o)
call seq_cdata_setptrs
(cdata_i, gsMap=gsMap_i, dom=dom_i)
call seq_cdata_setptrs
(cdata_o, mpicom=mpicom)
! Sanity check
ocnsize = mct_gsMap_gsize(gsMap_o)
icesize = mct_gsMap_gsize(gsMap_i)
if (ocnsize /= icesize) then
write(logunit,*) "(map_ocn2ice_init_mct) ocean and ice are different."
write(logunit,*) "(map_ocn2ice_init_mct) Must be t.Exiting."
call shr_sys_abort
(subName // "different ocn")
endif
! Initialize rearranger
call mct_rearr_init(gsMap_o, gsMap_i, mpicom, Re_ocn2ice)
! Set ice aream to ocn aream
! Note that "aream" attribute of dom_o%data is set in routine map_ocn2atm_init_mct
lsize = mct_gsMap_lsize(gsMap_o, mpicom)
call mct_aVect_init( areasrc, rList="aream", lsize=lsize )
lsize = mct_gsMap_lsize(gsMap_i, mpicom)
call mct_aVect_init( areadst, rList="aream", lsize=lsize )
km = mct_aVect_indexRA(dom_o%data,"aream")
ka = mct_aVect_indexRA(areasrc ,"aream")
areasrc%rAttr(ka,:) = dom_o%data%rAttr(km,:)
call mct_rearr_rearrange(areasrc, areadst, Re_ocn2ice, VECTOR=usevector, ALLTOALL=usealltoall)
ka = mct_aVect_indexRA(areadst ,"aream")
km = mct_aVect_indexRA(dom_i%data,"aream")
dom_i%data%rAttr(km,:) = areadst%rAttr(ka,:)
call mct_aVect_clean(areasrc)
call mct_aVect_clean(areadst)
end subroutine map_ocn2ice_init_mct
!=============================================================
subroutine map_ice2ocn_init_mct( cdata_i, cdata_o) 1,4
!---------------------------------------------
!
! Arguments
!
type(seq_cdata),intent(in) :: cdata_i
type(seq_cdata),intent(in) :: cdata_o
!
! Local Variables
!
integer :: ocnsize, icesize ! global grid sizes
type(mct_gsMap), pointer :: gsMap_i ! ice gsMap
type(mct_gsMap), pointer :: gsMap_o ! ocn gsMap
integer :: mpicom ! communicator spanning ocn and ice
!---------------------------------------------
call seq_cdata_setptrs
(cdata_i, gsMap=gsMap_i)
call seq_cdata_setptrs
(cdata_o, gsMap=gsMap_o)
call seq_cdata_setptrs
(cdata_o, mpicom=mpicom)
! Sanity check
ocnsize = mct_gsMap_gsize(gsMap_o)
icesize = mct_gsMap_gsize(gsMap_i)
if (ocnsize /= icesize) then
write(logunit,*) "(map_ice2ocn_init_mct) ocean and ice grids are different."
write(logunit,*) "(map_ice2ocn_init_mct) Must be the same....Exiting."
call shr_sys_abort
(subName // "different ocn,ice grids")
endif
! Initialize rearranger
call mct_rearr_init(gsMap_i, gsMap_o, mpicom, Re_ice2ocn)
end subroutine map_ice2ocn_init_mct
!=======================================================================
subroutine map_ocn2ice_mct( cdata_o, av_o, cdata_i, av_i, fluxlist, statelist ) 3,2
!-----------------------------------------------------
!
! Arguments
!
type(seq_cdata),intent(in) :: cdata_o
type(mct_aVect),intent(in) :: av_o
type(seq_cdata),intent(in) :: cdata_i
type(mct_aVect),intent(out):: av_i
character(len=*),intent(in), optional :: fluxlist
character(len=*),intent(in), optional :: statelist
!-----------------------------------------------------
if (present(fluxlist) .or. present(statelist)) then
if (present(fluxlist)) then
call mct_rearr_rearrange_fldlist
(av_o, av_i, Re_ocn2ice, VECTOR=usevector, &
ALLTOALL=usealltoall, fldlist=fluxlist)
endif
if (present(statelist)) then
call mct_rearr_rearrange_fldlist
(av_o, av_i, Re_ocn2ice, VECTOR=usevector, &
ALLTOALL=usealltoall, fldlist=statelist)
endif
else
call mct_rearr_rearrange(av_o, av_i, Re_ocn2ice, VECTOR=usevector, ALLTOALL=usealltoall)
end if
end subroutine map_ocn2ice_mct
!=======================================================================
subroutine map_ice2ocn_mct( cdata_i, av_i, cdata_o, av_o, fluxlist, statelist) 4,2
!-----------------------------------------------------
!
! Arguments
!
type(seq_cdata),intent(in) :: cdata_i
type(mct_aVect),intent(in) :: av_i
type(seq_cdata),intent(in) :: cdata_o
type(mct_aVect),intent(out):: av_o
character(len=*),intent(in), optional :: fluxlist
character(len=*),intent(in), optional :: statelist
!-----------------------------------------------------
if (present(fluxlist) .or. present(statelist)) then
if (present(fluxlist)) then
call mct_rearr_rearrange_fldlist
(av_i, av_o, Re_ice2ocn, VECTOR=usevector, &
ALLTOALL=usealltoall, fldlist=fluxlist)
endif
if (present(statelist)) then
call mct_rearr_rearrange_fldlist
(av_i, av_o, Re_ice2ocn, VECTOR=usevector, &
ALLTOALL=usealltoall, fldlist=statelist)
endif
else
call mct_rearr_rearrange(av_i, av_o, Re_ice2ocn, VECTOR=usevector, ALLTOALL=usealltoall)
end if
end subroutine map_ice2ocn_mct
end module map_iceocn_mct