module map_snoglc_mct 2,4 !--------------------------------------------------------------------- ! ! Purpose: ! ! Collect coupling routines for sequential coupling of SNO-GLC. ! ! 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_sno2glc_init_mct public :: map_glc2sno_init_mct public :: map_sno2glc_mct public :: map_glc2sno_mct !-------------------------------------------------------------------------- ! Public data !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- type(mct_rearr), private :: Re_sno2glc type(mct_rearr), private :: Re_glc2sno #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_snoglc_mct)' !======================================================================= contains !======================================================================= subroutine map_glc2sno_init_mct( cdata_g, cdata_s) 1,4 !----------------------------------------------------- ! ! Arguments ! type(seq_cdata),intent(in) :: cdata_g type(seq_cdata),intent(in) :: cdata_s ! ! Local Variables ! integer :: glcsize, snosize ! global grid sizes type(mct_gsMap), pointer :: gsMap_s ! sno gsMap type(mct_gsMap), pointer :: gsMap_g ! glc gsMap integer :: mpicom ! communicator spanning glc and sno !----------------------------------------------------- call seq_cdata_setptrs(cdata_g, gsMap=gsMap_g) call seq_cdata_setptrs(cdata_s, gsMap=gsMap_s) call seq_cdata_setptrs(cdata_g, mpicom=mpicom) ! Sanity check glcsize = mct_gsMap_gsize(gsMap_g) snosize = mct_gsMap_gsize(gsMap_s) if (glcsize /= snosize) then write(logunit,*) "(map_glc2sno_init_mct) sno and glc are different." write(logunit,*) "(map_glc2sno_init_mct) Must be same size. Exiting." call shr_sys_abort(subName // "different size") endif ! Initialize rearranger call mct_rearr_init(gsMap_g, gsMap_s, mpicom, Re_glc2sno) end subroutine map_glc2sno_init_mct !============================================================= subroutine map_sno2glc_init_mct( cdata_s, cdata_g) 1,4 !--------------------------------------------- ! ! Arguments ! type(seq_cdata),intent(in) :: cdata_s type(seq_cdata),intent(in) :: cdata_g ! ! Local Variables ! integer :: glcsize, snosize ! global grid sizes type(mct_gsMap), pointer :: gsMap_s ! sno gsMap type(mct_gsMap), pointer :: gsMap_g ! glc gsMap integer :: mpicom ! communicator spanning glc and sno integer :: ka, km ! indsnos type(mct_gGrid), pointer :: dom_s ! sno domain type(mct_gGrid), pointer :: dom_g ! glc domain integer :: lsize ! size of attribute vector type(mct_aVect) :: areasrc ! glc areas from mapping file type(mct_aVect) :: areadst ! sno areas from mapping file !--------------------------------------------- call seq_cdata_setptrs(cdata_s, gsMap=gsMap_s, dom=dom_s) call seq_cdata_setptrs(cdata_g, gsMap=gsMap_g, dom=dom_g) call seq_cdata_setptrs(cdata_g, mpicom=mpicom) ! Sanity check glcsize = mct_gsMap_gsize(gsMap_g) snosize = mct_gsMap_gsize(gsMap_s) if (glcsize /= snosize) then write(logunit,*) "(map_sno2glc_init_mct) glc and sno grids are different." write(logunit,*) "(map_sno2glc_init_mct) Must be the same....Exiting." call shr_sys_abort(subName // "different glc,sno grids") endif ! Initialize rearranger call mct_rearr_init(gsMap_s, gsMap_g, mpicom, Re_sno2glc) ! Set glc aream to sno aream ! Note that "aream" attribute of dom_s%data is set in routine map_atm2sno_init_mct lsize = mct_gsMap_lsize(gsMap_s, mpicom) call mct_aVect_init( areasrc, rList="aream", lsize=lsize ) lsize = mct_gsMap_lsize(gsMap_g, mpicom) call mct_aVect_init( areadst, rList="aream", lsize=lsize ) km = mct_aVect_indexRA(dom_s%data,"aream") ka = mct_aVect_indexRA(areasrc ,"aream") areasrc%rAttr(ka,:) = dom_s%data%rAttr(km,:) ! tcraig, 6/2010, initialize areadst with dom_g km because areasrc is only over land ka = mct_aVect_indexRA(areadst ,"aream") km = mct_aVect_indexRA(dom_g%data,"aream") areadst%rAttr(ka,:) = dom_g%data%rAttr(km,:) call mct_rearr_rearrange(areasrc, areadst, Re_sno2glc, VECTOR=usevector, ALLTOALL=usealltoall) ka = mct_aVect_indexRA(areadst ,"aream") km = mct_aVect_indexRA(dom_g%data,"aream") dom_g%data%rAttr(km,:) = areadst%rAttr(ka,:) call mct_aVect_clean(areasrc) call mct_aVect_clean(areadst) end subroutine map_sno2glc_init_mct !======================================================================= subroutine map_glc2sno_mct( cdata_g, av_g, cdata_s, av_s, fluxlist, statelist ) 1,2 !----------------------------------------------------- ! ! Arguments ! type(seq_cdata),intent(in) :: cdata_g type(mct_aVect),intent(in) :: av_g type(seq_cdata),intent(in) :: cdata_s type(mct_aVect),intent(out):: av_s 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_g, av_s, Re_glc2sno, VECTOR=usevector, & ALLTOALL=usealltoall, fldlist=fluxlist) endif if (present(statelist)) then call mct_rearr_rearrange_fldlist(av_g, av_s, Re_glc2sno, VECTOR=usevector, & ALLTOALL=usealltoall, fldlist=statelist) endif else call mct_rearr_rearrange(av_g, av_s, Re_glc2sno, VECTOR=usevector, ALLTOALL=usealltoall) end if end subroutine map_glc2sno_mct !======================================================================= subroutine map_sno2glc_mct( cdata_s, av_s, cdata_g, av_g, fluxlist, statelist) 2,2 !----------------------------------------------------- ! ! Arguments ! type(seq_cdata),intent(in) :: cdata_s type(mct_aVect),intent(in) :: av_s type(seq_cdata),intent(in) :: cdata_g type(mct_aVect),intent(out):: av_g 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_s, av_g, Re_sno2glc, VECTOR=usevector, & ALLTOALL=usealltoall, fldlist=fluxlist) endif if (present(statelist)) then call mct_rearr_rearrange_fldlist(av_s, av_g, Re_sno2glc, VECTOR=usevector, & ALLTOALL=usealltoall, fldlist=statelist) endif else call mct_rearr_rearrange(av_s, av_g, Re_sno2glc, VECTOR=usevector, ALLTOALL=usealltoall) end if end subroutine map_sno2glc_mct end module map_snoglc_mct