module seq_rearr_mod 7,7
!---------------------------------------------------------------------
!
! Purpose:
!
! Shared routines for computation of rearrangers
!
! Author: T Craig
!
!---------------------------------------------------------------------
use shr_sys_mod
use mct_mod
use seq_flds_mod
use seq_cdata_mod
use seq_comm_mct
use seq_diag_mct
use shr_kind_mod, only: R8 => SHR_KIND_R8
implicit none
save
private ! except
!--------------------------------------------------------------------------
! Public interfaces
!--------------------------------------------------------------------------
public :: seq_rearr_init
public :: seq_rearr_gsmapIdentical
private :: seq_rearr_gsmapExtend
private :: seq_rearr_gsmapCreate
private :: seq_rearr_avExtend
private :: seq_rearr_avCreate
!--------------------------------------------------------------------------
! Public data
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! Private data
!--------------------------------------------------------------------------
#ifdef CPP_VECTOR
logical :: usevector = .true.
#else
logical :: usevector = .false.
#endif
#ifdef SYSUNICOS
logical :: usealltoall = .true.
#else
logical :: usealltoall = .false.
#endif
character(*),parameter :: subName = '(seq_rearr_mct)'
real(r8),parameter :: c1 = 1.0_r8
#include <mpif.h>
!=======================================================================
contains
!=======================================================================
subroutine seq_rearr_init( cdata_old, AV1_old, AV2_old, ID_old, & 7,15
cdata_new, AV1_new, AV2_new, ID_new, ID_join, &
Re_old2new, Re_new2old)
! This routine modifies and initializes a bunch of datatypes to
! handle rearranging of AVs between different pes for a single
! component. Basically, the "old" data exists on a set of pes
! associated with ID_old. We want to initialize a rearranger
! between ID_old and ID_new and datatypes on ID_new that will
! supporting moving of data between ID_old and ID_new. Nothing
! is set on ID_new except it's ID, so we need to create a gsmap
! on those pes associated with the same global grid (but maybe
! with a different decomp). Then we can initialize a rearranger
! between the old and new gsmap as well as initialize the new
! AVs and new domain. In the process, AVs and gsmaps need to be
! "extended" to span all pes in the joined ID, instead of just
! the pes of their original ID. This has nothing to do with
! changing the gsmap, decomp, or data. It just involves copying
! the gsmap to the new joined pes and allocating AVs on those
! extended pes with local size zero and the proper fields. These
! extended versions of gsmaps and AVs are then carried around
! in the driver without any problems, but they can be used to
! rearrange data across the joined pes.
implicit none
!-----------------------------------------------------
!
! Arguments
!
type(seq_cdata),intent(in) :: cdata_old
type(mct_aVect),intent(inout),optional :: AV1_old
type(mct_aVect),intent(inout),optional :: AV2_old
integer ,intent(in) :: ID_old
type(seq_cdata),intent(inout) :: cdata_new
type(mct_aVect),intent(inout),optional :: AV1_new
type(mct_aVect),intent(inout),optional :: AV2_new
integer ,intent(in) :: ID_new
integer ,intent(in) :: ID_join
type(mct_rearr),intent(inout) :: Re_old2new
type(mct_rearr),intent(inout) :: Re_new2old
!
! Local Variables
!
character(len=*),parameter :: subname = "(seq_rearr_init) "
type(mct_gsMap), pointer :: gsmap_new ! new gsMap
type(mct_gsMap), pointer :: gsmap_old ! old gsMap
type(mct_gGrid), pointer :: dom_new ! new domain
type(mct_gGrid), pointer :: dom_old ! old domain
integer :: lsize
integer :: mpicom_old
integer :: mpicom_new
integer :: mpicom_join
logical :: master_join
integer :: mpigrp_old, mpigrp_join
integer :: ierr
integer :: ID
type(mct_gsMap) :: gsmap_new_join ! gsmap_new on joined id
type(mct_gsMap) :: gsmap_old_join ! gsmap_old on joined id
type(mct_gGrid) :: dom_join ! gathered grid
type(mct_gGrid) :: dom_empty ! empty grid
!-----------------------------------------------------
! --- Setup data for use and make sure the old ID is ok
call seq_cdata_setptrs(cdata_old, gsMap=gsmap_old, dom=dom_old, ID=ID)
call seq_cdata_setptrs(cdata_new, gsMap=gsmap_new, dom=dom_new)
if (ID /= ID_old) then
write(logunit,*) subname,' ERROR: inconsistent ID',ID,ID_old
call shr_sys_abort()
endif
call seq_comm_setptrs(ID_old ,mpicom=mpicom_old ,mpigrp=mpigrp_old )
call seq_comm_setptrs(ID_new ,mpicom=mpicom_new )
call seq_comm_setptrs(ID_join,mpicom=mpicom_join,mpigrp=mpigrp_join,iamroot=master_join)
! --- Set gsmaps
! --- Extend the old one to now span all pes on ID_join
! --- Create a new gsmap on pes associated with ID_new using info from the old one
! --- Extend the new one to span all pes on ID_join
call seq_rearr_gsmapExtend(gsmap_old , mpicom_old , gsmap_old_join, mpicom_join, ID_join)
call seq_rearr_gsmapCreate(gsmap_old_join, mpicom_join , gsmap_new , mpicom_new , ID_new )
call seq_rearr_gsmapExtend(gsmap_new , mpicom_new , gsmap_new_join, mpicom_join, ID_join)
! --- Initialize rearrangers based on join gsmaps
call mct_rearr_init(gsmap_old_join, gsmap_new_join, mpicom_join, Re_old2new)
call mct_rearr_init(gsmap_new_join, gsmap_old_join, mpicom_join, Re_new2old)
! --- Finish setting up the new information. extend dom_old and rearrange it to dom_new
lsize = mct_gsMap_lsize(gsmap_new_join, mpicom_join)
call mct_gGrid_init( GGrid=dom_new, CoordChars=seq_flds_dom_coord, OtherChars=seq_flds_dom_other, lsize=lsize )
call mct_avect_zero(dom_new%data)
call seq_rearr_avExtend(dom_old%data, ID_old, ID_join)
call mct_rearr_rearrange(dom_old%data, dom_new%data, Re_old2new, VECTOR=usevector, ALLTOALL=usealltoall)
! --- Clean temporary gsmaps
call mct_gsMap_clean(gsmap_old_join)
call mct_gsMap_clean(gsmap_new_join)
! --- Extend old avs and initialize new avs for use in the future
lsize = 0
if (seq_comm_iamin(ID_new)) then
lsize = mct_gsMap_lsize(gsMap_new,mpicom_new)
endif
if (present(AV1_old)) then
call seq_rearr_avExtend(AV1_old, ID_old, ID_join)
if (present(AV1_new)) then
call seq_rearr_avCreate(AV1_old, ID_old, AV1_new, ID_join, lsize)
endif
endif
if (present(AV2_old)) then
call seq_rearr_avExtend(AV2_old, ID_old, ID_join)
if (present(AV2_new)) then
call seq_rearr_avCreate(AV2_old, ID_old, AV2_new, ID_join, lsize)
endif
endif
end subroutine seq_rearr_init
!=======================================================================
subroutine seq_rearr_gsmapExtend(gsmapi, mpicomi, gsmapo, mpicomo, compido) 2,12
!----------------------------------------------------------------
! Extend/Convert a gsmap from one mpicom to another mpicom that contains
! at least all the pes that gsmap uses, but with different ranks
!----------------------------------------------------------------
implicit none
type(mct_gsMap), intent(IN) :: gsmapi
integer , intent(IN) :: mpicomi
type(mct_gsMap), intent(OUT):: gsmapo
integer , intent(IN) :: mpicomo
integer , intent(IN) :: compido
character(len=*),parameter :: subname = "(seq_rearr_gsmapExtend) "
integer :: n
integer :: ngseg
integer :: gsize
integer :: msizei,msizeo
integer :: mrank,mranko,mrankog ! sets pe rank of root mpicomi pe in mpicomo
integer :: mpigrpi,mpigrpo
integer :: ierr
integer, pointer :: pei(:),peo(:)
integer, pointer :: start(:),length(:),peloc(:)
mranko = -1
! --- create the new gsmap on the mpicomi root only
if (mpicomi /= MPI_COMM_NULL) then
call mpi_comm_rank(mpicomi,mrank,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_comm_rank i')
if (mrank == 0) then
call mpi_comm_group(mpicomi,mpigrpi,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_comm_group i')
call mpi_comm_group(mpicomo,mpigrpo,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_comm_group o')
call mpi_comm_size(mpicomi,msizei,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_comm_size i')
call mpi_comm_size(mpicomo,msizeo,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_comm_size o')
! --- setup the translation of pe numbers from the old gsmap(mpicom)
! --- to the new one, pei -> peo
allocate(pei(0:msizei-1),peo(0:msizei-1))
do n = 0,msizei-1
pei(n) = n
enddo
peo = -1
call mpi_group_translate_ranks(mpigrpi,msizei,pei,mpigrpo,peo,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_group_translate_ranks')
do n = 0,msizei-1
if (peo(n) < 0 .or. peo(n) > msizeo-1) then
write(logunit,*) subname,' peo out of bounds ',peo(n),msizeo
call shr_sys_abort()
endif
enddo
mranko = peo(0)
! --- compute the new gsmap which has the same start and length values
! --- but peloc is now the mapping of pei to peo
ngseg = gsmapi%ngseg
gsize = gsmapi%gsize
allocate(start(ngseg),length(ngseg),peloc(ngseg))
do n = 1,ngseg
start(n) = gsmapi%start(n)
length(n) = gsmapi%length(n)
peloc(n) = peo(gsmapi%pe_loc(n))
enddo
! --- initialize the gsmap on the root pe
call mct_gsmap_init(gsmapo,compido,ngseg,gsize,start,length,peloc)
deallocate(pei,peo,start,length,peloc)
endif
endif
! --- broadcast via allreduce the mpicomi root pe in mpicomo space
! --- mranko is -1 except on the root pe where is it peo of that pe
call mpi_allreduce(mranko,mrankog,1,MPI_INTEGER,MPI_MAX,mpicomo,ierr)
call shr_mpi_chkerr(ierr,subname//' gsm_cop mpi_allreduce max')
! --- broadcast the gsmap to all pes in mpicomo from mrankog
call mct_gsmap_bcast(gsmapo, mrankog, mpicomo)
! tcx summarize decomp info
#if (1 == 0)
write(logunit,*) trim(subname),'tcxa ',mpicomi,mpicomo
call shr_sys_flush(logunit)
call mpi_barrier(mpicomo,ierr)
if (mpicomi /= MPI_COMM_NULL) then
call mpi_comm_rank(mpicomi,mrank,ierr)
write(logunit,*) 'tcxbi ',mrank
if (mrank == 0) then
write(logunit,*) 'tcxci ',gsmapi%ngseg,size(gsmapi%start),gsmapi%gsize,gsmapi%comp_id
do n = 1,gsmapi%ngseg
write(logunit,*) 'tcx gsmti ',n,gsmapi%start(n),gsmapi%length(n),gsmapi%pe_loc(n)
enddo
call shr_sys_flush(logunit)
endif
endif
if (mpicomo /= MPI_COMM_NULL) then
call mpi_comm_rank(mpicomo,mrank,ierr)
write(logunit,*) 'tcxbo ',mrank
if (mrank == 0) then
write(logunit,*) 'tcxco ',gsmapo%ngseg,size(gsmapo%start),gsmapo%gsize,gsmapo%comp_id
do n = 1,gsmapo%ngseg
write(logunit,*) 'tcx gsmto ',n,gsmapo%start(n),gsmapo%length(n),gsmapo%pe_loc(n)
enddo
call shr_sys_flush(logunit)
endif
endif
call shr_sys_flush(logunit)
call mpi_barrier(mpicomo,ierr)
#endif
end subroutine seq_rearr_gsmapExtend
!=======================================================================
subroutine seq_rearr_gsmapCreate(gsmapi, mpicomi, gsmapo, mpicomo, compido) 1,7
!---------------------------------------------------------------------
! creates a new gsmap on a subset of pes, requires setting a new decomp
!---------------------------------------------------------------------
implicit none
type(mct_gsMap), intent(IN) :: gsmapi
integer , intent(IN) :: mpicomi
type(mct_gsMap), intent(OUT):: gsmapo
integer , intent(IN) :: mpicomo
integer , intent(IN) :: compido
character(len=*),parameter :: subname = "(seq_rearr_gsmapCreate) "
integer :: n,m,k
integer :: ktot ! number of active cells in gsmap
integer :: apesi, apeso ! number of active pes in gsmap
integer :: lsizeo ! local size for lindex
integer :: ngsegi,ngsego ! ngseg of mpicomi, mpicomo
integer :: gsizei,gsizeo ! gsize of mpicomi, mpicomo
integer :: msizei,msizeo ! size of mpicomi, mpicomo
integer :: mranki,mranko ! rank in mpicomi, mpicomo
integer :: ierr
integer :: decomp_type
integer, pointer :: start(:),length(:),peloc(:),perm(:),gindex(:),lindex(:)
real(r8):: rpeloc
! --- create a new gsmap on new pes based on the old gsmap
! --- gsmapi must be known on all mpicomo pes, compute the same
! --- thing on all pes in parallel
if (mpicomo /= MPI_COMM_NULL) then
call mpi_comm_rank(mpicomi,mranki,ierr)
call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank i')
call mpi_comm_size(mpicomi,msizei,ierr)
call shr_mpi_chkerr(ierr,subname//' mpi_comm_size i')
call mpi_comm_rank(mpicomo,mranko,ierr)
call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank o')
call mpi_comm_size(mpicomo,msizeo,ierr)
call shr_mpi_chkerr(ierr,subname//' mpi_comm_size o')
ngsegi = gsmapi%ngseg
gsizei = gsmapi%gsize
gsizeo = gsizei
call mct_gsMap_activepes(gsmapi,apesi)
decomp_type = 0
if (msizeo == apesi) then ! preserve segments and decomp
! decomp_type = 1 ! better in cpl to have all decomps "same-ish"
decomp_type = 2
elseif (ngsegi >= msizeo) then ! preserve segments, new decomp
decomp_type = 2
else ! new segments
decomp_type = 3
endif
!tcx decomp_type = 3 ! over ride setting above for testing
! if (mranko == 0) write(logunit,'(2A,4I)') trim(subname),' decomp_type =',decomp_type,ngsegi,msizeo,apesi
select case (decomp_type)
case(1) ! --- preserve segments and decomp ---------------------
! -- copy the gsmap and translate the pes
call mct_gsMap_copy(gsmapi,gsmapo)
ngsego = ngsegi
do n = 1,ngsego
gsmapo%pe_loc(n) = mod(gsmapo%pe_loc(n),msizeo) ! translate pes 1:1 from old to new
enddo
case(2) ! --- preserve segments, new decomp --------------------
! --- preserve segments, sort the start and length, assign a new pe list
ngsego = ngsegi
allocate(start(ngsego),length(ngsego),peloc(ngsego),perm(ngsego))
do n = 1,ngsego
start(n) = gsmapi%start(n)
length(n) = gsmapi%length(n)
enddo
! --- sort gsmap to minimize permute cost in mct
call mct_indexset(perm)
call mct_indexsort(ngsego,perm,start)
call mct_permute(start,perm,ngsego)
call mct_permute(length,perm,ngsego)
! --- give each pe "equal" number of segments, use reals to avoid integer overflow
do n = 1,ngsego
rpeloc = (((msizeo*c1)*((n-1)*c1))/(ngsego*c1)) ! give each pe "equal" number of segments, use reals to avoid integer overflow
peloc(n) = int(rpeloc)
enddo
call mct_gsmap_init(gsmapo,ngsego,start,length,peloc,0,mpicomo,compido,gsizeo)
deallocate(start,length,peloc,perm)
case(3) ! --- new segments, new decomp -------------------------
! --- new segments, compute gindex, then parse the gridcells out evenly
k = 0
do n = 1,ngsegi
do m = 1,gsmapi%length(n)
k = k + 1
if (k > gsizei) then
write(logunit,*) trim(subname),' ERROR in gindex ',k,gsizei
call shr_sys_abort()
endif
enddo
enddo
ktot = k
allocate(gindex(ktot),perm(ktot))
k = 0
do n = 1,ngsegi
do m = 1,gsmapi%length(n)
k = k + 1
gindex(k) = gsmapi%start(n) + m - 1
enddo
enddo
call mct_indexset(perm)
call mct_indexsort(ktot,perm,gindex)
call mct_permute(gindex,perm,ktot)
k = 0
do m = 0,msizeo-1
lsizeo = ktot/msizeo
if (m < (ktot - lsizeo*msizeo)) lsizeo = lsizeo + 1
if (mranko == m) then
allocate(lindex(lsizeo))
if (k+lsizeo > ktot) then
write(logunit,*) trim(subname),' ERROR: decomp out of bounds ',mranko,k,lsizeo,ktot
call shr_sys_abort()
endif
lindex(1:lsizeo) = gindex(k+1:k+lsizeo)
! write(logunit,*) trim(subname),' decomp is ',mranko,lsizeo,k+1,k+lsizeo
endif
k = k + lsizeo
enddo
if (k /= ktot) then
write(logunit,*) trim(subname),' ERROR: decomp incomplete ',k,ktot
call shr_sys_abort()
endif
call mct_gsmap_init(gsmapo,lindex,mpicomo,compido,size(lindex),gsizeo)
deallocate(gindex,perm,lindex)
end select
if (mranko == 0) then
write(logunit,102) trim(subname),' created new gsmap decomp_type =',decomp_type
write(logunit,102) trim(subname),' ngseg/gsize = ', &
mct_gsmap_ngseg(gsmapo),mct_gsmap_gsize(gsmapo)
call mct_gsmap_activepes(gsmapo,apeso)
write(logunit,102) trim(subname),' mpisize/active_pes = ', &
msizeo,apeso
write(logunit,102) trim(subname),' avg seg per pe/ape = ', &
mct_gsmap_ngseg(gsmapo)/msizeo,mct_gsmap_ngseg(gsmapo)/apeso
write(logunit,102) trim(subname),' nlseg/maxnlsegs = ', &
mct_gsmap_nlseg(gsmapo,0),mct_gsmap_maxnlseg(gsmapo)
102 format(2A,2I8)
endif
!p if (.not. mct_gsmap_increasing(gsmapo) ) then
! write(logunit,*) trim(subname),' ERROR: gsmapo not increasing'
! call shr_sys_abort()
! endif
endif
end subroutine seq_rearr_gsmapCreate
!=======================================================================
subroutine seq_rearr_avExtend(AVin,IDin,ID) 3,3
!-----------------------------------------------------------------------
! Extend an AV to a larger set of pes or
! Initialize an AV on another set of pes
!-----------------------------------------------------------------------
implicit none
type(mct_aVect), intent(INOUT):: AVin
integer ,intent(IN) :: IDin ! ID associated with AVin
integer , intent(IN) :: ID ! ID to initialize over
! Local variables
character(len=*),parameter :: subname = "(seq_rearr_avExtend) "
integer :: mpicom
integer :: rank,rank2
integer :: lsizei, lsizen
integer :: srank,srankg
integer :: ierr
integer :: nints
character(len=1024) :: iList,rList
call seq_comm_setptrs(ID,mpicom=mpicom,iam=rank)
! --- lsizen is the size of the newly initialized AV, zero is valid
! --- lsizei is -1 on any peszero on any pes where AV is not yet initialized
lsizei = -1
if (seq_comm_iamin(IDin)) lsizei = mct_aVect_lsize(AVin)
lsizen = 0
! --- find a pe that already has AVin allocated, use MPI_MAX to do so
! --- set the pe and broadcast it to all other pes using mpi_allreduce
srank = -1
srankg = -1
if (lsizei > 0) srank = rank
call mpi_allreduce(srank,srankg,1,MPI_INTEGER,MPI_MAX,mpicom,ierr)
call shr_mpi_chkerr(ierr,subname//' mpi_allreduce max')
if (srankg < 0) then
write(logunit,*) subname,' WARNING AVin empty '
return
endif
! --- set the iList and rList from the broadcast pe (srankg) and
! --- broadcast the lists
iList = " "
rList = " "
if (rank == srankg) then
if (mct_aVect_nIAttr(AVin) /= 0) iList = mct_aVect_ExportIList2c(AVin)
if (mct_aVect_nRattr(AVin) /= 0) rList = mct_aVect_ExportRList2c(AVin)
endif
call mpi_bcast(iList,len(iList),MPI_CHARACTER,srankg,mpicom,ierr)
call mpi_bcast(rList,len(rList),MPI_CHARACTER,srankg,mpicom,ierr)
! --- now allocate the AV on any pes where the orig size is zero. those
! --- should be pes that either have no data and may have been allocated
! --- before (no harm in doing it again) or have never been allocated
if (lsizei <= 0) then
if(len_trim(iList) > 0 .and. len_trim(rList) > 0) then
call mct_aVect_init(AVin,iList=iList,rList=rList,lsize=lsizen)
elseif (len_trim(iList) > 0 .and. len_trim(rList) == 0) then
call mct_aVect_init(AVin,iList=iList,lsize=lsizen)
elseif (len_trim(iList) == 0 .and. len_trim(rList) > 0) then
call mct_aVect_init(AVin,rList=rList,lsize=lsizen)
endif
endif
end subroutine seq_rearr_avExtend
!=======================================================================
subroutine seq_rearr_avCreate(AVin,IDin,AVout,ID,lsize) 2,4
!-----------------------------------------------------------------------
! Extend an AV to a larger set of pes or
! Initialize an AV on another set of pes
!-----------------------------------------------------------------------
implicit none
type(mct_aVect), intent(INOUT):: AVin
integer ,intent(IN) :: IDin ! ID associated with AVin
type(mct_aVect), intent(INOUT):: AVout
integer , intent(IN) :: ID ! ID to initialize over
integer , intent(IN) :: lsize
! Local variables
character(len=*),parameter :: subname = "(seq_rearr_avCreate) "
integer :: mpicom
integer :: rank,rank2
integer :: lsizei, lsizen
integer :: srank,srankg
integer :: ierr
integer :: nints
character(len=1024) :: iList,rList
call seq_comm_setptrs(ID,mpicom=mpicom,iam=rank)
! --- lsizen is the size of the newly initialized AV, zero is valid
lsizei = -1
if (seq_comm_iamin(IDin)) lsizei = mct_aVect_lsize(AVin)
lsizen = lsize
! --- find a pe that already has AVin allocated, use MPI_MAX to do so
! --- set the pe and broadcast it to all other pes
srank = -1
srankg = -1
if (lsizei > 0) srank = rank
call mpi_allreduce(srank,srankg,1,MPI_INTEGER,MPI_MAX,mpicom,ierr)
call shr_mpi_chkerr(ierr,subname//' mpi_allreduce max')
if (srankg < 0) then
write(logunit,*) subname,' ERROR AVin not initialized '
call shr_sys_abort()
endif
! --- set the iList and rList from the broadcast pe (srankg) and
! --- broadcast the lists
iList = " "
rList = " "
if (rank == srankg) then
if (mct_aVect_nIAttr(AVin) /= 0) iList = mct_aVect_ExportIList2c(AVin)
if (mct_aVect_nRattr(AVin) /= 0) rList = mct_aVect_ExportRList2c(AVin)
endif
call mpi_bcast(iList,len(iList),MPI_CHARACTER,srankg,mpicom,ierr)
call mpi_bcast(rList,len(rList),MPI_CHARACTER,srankg,mpicom,ierr)
! --- now allocate the AV on all pes. the AV should not exist before.
! --- If it does, mct should die.
if(len_trim(iList) > 0 .and. len_trim(rList) > 0) then
call mct_aVect_init(AVout,iList=iList,rList=rList,lsize=lsizen)
elseif (len_trim(iList) > 0 .and. len_trim(rList) == 0) then
call mct_aVect_init(AVout,iList=iList,lsize=lsizen)
elseif (len_trim(iList) == 0 .and. len_trim(rList) > 0) then
call mct_aVect_init(AVout,rList=rList,lsize=lsizen)
endif
end subroutine seq_rearr_avCreate
!=======================================================================
logical function seq_rearr_gsmapIdentical(gsmap1,gsmap2) 7
implicit none
type(mct_gsMap), intent(IN):: gsmap1
type(mct_gsMap), intent(IN):: gsmap2
! Local variables
character(len=*),parameter :: subname = "(seq_rearr_gsmapIdentical) "
integer :: n
logical :: identical
!-----------------------
identical = .true.
! --- continue compare ---
if (identical) then
if (mct_gsMap_gsize(gsmap1) /= mct_gsMap_gsize(gsmap2)) identical = .false.
if (mct_gsMap_ngseg(gsmap1) /= mct_gsMap_ngseg(gsmap2)) identical = .false.
endif
! --- continue compare ---
if (identical) then
do n = 1,mct_gsMap_ngseg(gsmap1)
if (gsmap1%start(n) /= gsmap2%start(n) ) identical = .false.
if (gsmap1%length(n) /= gsmap2%length(n)) identical = .false.
if (gsmap1%pe_loc(n) /= gsmap2%pe_loc(n)) identical = .false.
enddo
endif
seq_rearr_gsmapIdentical = identical
end function seq_rearr_gsmapIdentical
!=======================================================================
end module seq_rearr_mod