module map_rofocn_mct 1,5 !--------------------------------------------------------------------- ! ! Purpose: ! ! Collect coupling routines for sequential coupling of OCN-ROF. ! ! ! Author: R. Jacob, M. Vertenstein ! !--------------------------------------------------------------------- use shr_sys_mod use shr_mct_mod, only: shr_mct_sMatPInitnc use mct_mod use seq_cdata_mod use seq_infodata_mod implicit none private ! except !-------------------------------------------------------------------------- ! Public interfaces !-------------------------------------------------------------------------- public :: map_rof2ocn_init_mct public :: map_rof2ocn_mct !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- type(mct_rearr), private :: Re_rof2ocn type(mct_sMatp), private :: sMatp_Fr2o #ifdef CPP_VECTOR logical :: usevector = .true. #else logical :: usevector = .false. #endif #ifdef SYSUNICOS logical :: usealltoall = .true. #else logical :: usealltoall = .false. #endif logical, private :: samegrid_mapr2o character(*),parameter :: subName = '(map_rofocn_mct) ' !======================================================================= contains !======================================================================= subroutine map_rof2ocn_init_mct( cdata_r, cdata_o) 1,6 !----------------------------------------------------- ! ! Arguments ! type(seq_cdata),intent(in) :: cdata_r type(seq_cdata),intent(in) :: cdata_o ! ! Local Variables ! integer :: km,ka ! indices type(seq_infodata_type), pointer :: infodata type(mct_gsMap), pointer :: gsMap_r ! runoff gsMap type(mct_gsMap), pointer :: gsMap_o ! ocn gsMap type(mct_ggrid), pointer :: dom_r ! runoff domain type(mct_ggrid), pointer :: dom_o ! ocn domain integer :: mpicom ! communicator spanning rof and ocn integer :: lsize ! size of attribute vector type(mct_aVect) :: areasrc ! ocn areas from mapping file type(mct_aVect) :: areadst ! rof areas from mapping file type(mct_rearr) :: Re_ocn2rof character(*),parameter :: subName = '(map_rof2ocn_mct) ' !----------------------------------------------------- ! Obtain pointers to gsmaps, domains and communicator call seq_cdata_setptrs(cdata_r, gsMap=gsMap_r, dom=dom_r) call seq_cdata_setptrs(cdata_o, gsMap=gsMap_o, dom=dom_o) call seq_cdata_setptrs(cdata_o, mpicom=mpicom, infodata=infodata) call seq_infodata_GetData(infodata, samegrid_ro=samegrid_mapr2o) if (samegrid_mapr2o) then call mct_rearr_init(gsMap_r, gsMap_o, mpicom, Re_rof2ocn) call mct_rearr_init(gsMap_o, gsMap_r, mpicom, Re_ocn2rof) ! copy ocn aream to rof aream ! lsize = mct_gsMap_lsize(gsMap_o, mpicom) ! call mct_aVect_init( areasrc, rList="aream", lsize=lsize ) ! lsize = mct_gsMap_lsize(gsMap_r, mpicom) ! call mct_aVect_init( areadst, rList="aream", lsize=lsize ) ! ka = mct_aVect_indexRa(dom_o%data, "aream" ) ! km = mct_aVect_indexRA(areasrc , "aream") ! areasrc%rAttr(km,:) = dom_o%data%rAttr(ka,:) call mct_rearr_rearrange_fldlist(dom_o%data, dom_r%data, Re_ocn2rof, VECTOR=usevector, & ALLTOALL=usealltoall, fldlist='aream') call mct_rearr_clean(Re_ocn2rof) ! ka = mct_aVect_indexRA(areadst ,"aream") ! km = mct_aVect_indexRA(dom_r%data,"aream") ! dom_r%data%rAttr(km,:) = areadst%rAttr(ka,:) ! call mct_aVect_clean(areasrc) ! call mct_aVect_clean(areadst) else ! Initialize rof->ocn mapping or rearranging lsize = mct_gsMap_lsize(gsMap_r, mpicom) call mct_aVect_init( areasrc, rList="aream", lsize=lsize ) call shr_mct_sMatPInitnc(sMatp_Fr2o, gsMap_r, gsMap_o, "seq_maps.rc", & "rof2ocnFmapname:","rof2ocnFmaptype:",mpicom, & areasrc=areasrc) ! Determine rof grid areas from mapping files km = mct_aVect_indexRA(dom_r%data,"aream", perrWith=subName) ka = mct_aVect_indexRA(areasrc ,"aream", perrWith=subName) dom_r%data%rAttr(km,:) = areasrc%rAttr(ka,:) call mct_aVect_clean(areasrc) endif end subroutine map_rof2ocn_init_mct !======================================================================= subroutine map_rof2ocn_mct( cdata_r, r2x_r, cdata_o, r2x_o) 1 type(seq_cdata),intent(in) :: cdata_r type(mct_aVect),intent(in) :: r2x_r type(seq_cdata),intent(in) :: cdata_o type(mct_aVect),intent(out):: r2x_o if (samegrid_mapr2o) then call mct_rearr_rearrange(r2x_r, r2x_o, Re_rof2ocn, VECTOR=usevector, & ALLTOALL=usealltoall) else !tcx call mct_aVect_zero(r2x_o) call mct_sMat_avMult(r2x_r, sMatp_Fr2o, r2x_o, VECTOR=usevector) endif end subroutine map_rof2ocn_mct !======================================================================= end module map_rofocn_mct