Back to OASIS3-MCT home

In oasis3-mct/lib/mct/mct :

m_GlobalSegMap.F90 :

CONTAINS
SUBROUTINE initd_(GSMap=prism_part(m)%gsmap, start=start, length=length, root=mpi_root_local, my_comm=mpi_comm_local, comp_id=compid, pe_loc, gsize, numel)  ! arguments in italic are optional but we put numel

! This routine takes the {\em scattered} input {\tt INTEGER} arrays
! {\tt start}, {\tt length}, and {\tt pe\_loc}, gathers these data to
! the {\tt root} process, and from them creates a {\em global} set of
! segment information for the output {\tt GlobalSegMap} argument
! {\tt GSMap}.  The input {\tt INTEGER} arguments {\tt comp\_id},
! {\tt gsize} provide the {\tt GlobalSegMap} component ID number and
! global grid size, respectively.  The input argument {\tt my\_comm} is
! the F90 {\tt INTEGER} handle for the MPI communicator.  If the input
! arrays are overdimensioned, optional argument {\em numel} can be
! used to specify how many elements should be used.
=> MP_COMM_RANK(my_comm, myID, ier)
if(present(numel)) then
    nlseg=numel
else
    nlseg = size(start)
endif
if(present(pe_loc)) then
     my_pe_loc => pe_loc
else
     allocate(my_pe_loc(nlseg), stat=ier)                                 ! our case
     if(ier /= 0) call die(myname_,'allocate(my_pe_loc)',ier)
     my_pe_loc = myID
endif
=> MPI_COMM_SIZE(my_comm, npes, ier)
nlseg_tmp(1) = nlseg
=> fc_gather_int(nlseg_tmp, 1, MP_INTEGER, counts, 1, MP_INTEGER, root, my_comm)
if(myID == root) then
     ngseg = 0
     do i=0,npes-1
        ngseg = ngseg + counts(i)
        if(i == 0) then
       displs(i) = 0
    else
       displs(i) = displs(i-1) + counts(i-1)
    endif
     end do
endif
if(myID == root) then
     allocate(root_start(ngseg), root_length(ngseg), &
          root_pe_loc(ngseg), stat=ier)
     if (ier /= 0) then
    call die(myname_, 'allocate(root_start...',ier)
     endif
else
     allocate(root_start(1), root_length(1), &
          root_pe_loc(1), stat=ier)
     if (ier /= 0) then
    call die(myname_, 'allocate((non)root_start...',ier)
     endif
endif
=> fc_gatherv_int(start, nlseg, MP_INTEGER, root_start, counts, displs, MP_INTEGER, root, my_comm)  ! each process sends its values of start(:) to fill in the appropriate portion of root_start(:y)
=> fc_gatherv_int(length, nlseg, MP_INTEGER, root_length, counts, displs, MP_INTEGER, root, my_comm)  ! each process sends its values of length(:) to fill in the appropriate portion of root_length(:)
=> fc_gatherv_int(my_pe_loc, nlseg, MP_INTEGER, root_pe_loc, counts, displs, MP_INTEGER, root, my_comm)  ! to fill in the appropriate portion of root_pe_loc(:) and make the correspondance between the nsegs and the proc that owns them (because the root has only a 1D array with all the segments indenpendently from the process)
=> MPI_BARRIER(my_comm, ier)
if(present(gsize)) then
=> initr_(GSMap, ngseg, root_start, root_length, root_pe_loc, root, my_comm, comp_id, gsize)
else
=> initr_(GSMap, ngseg, root_start, root_length, root_pe_loc, root, my_comm, comp_id)
if(myID == root) then
     GSMap%ngseg = ngseg
     GSMap%comp_id = comp_id
endif

SUBROUTINE initr_(GSMap, ngseg, start, length, pe_loc, root,  my_comm, comp_id, gsize)

! This routine takes the input {\tt INTEGER} arrays {\tt start},
! {\tt length}, and {\tt pe\_loc} (all valid only on the {\tt root}
! process), and from them creates a {\em global} set of segment
! information for the output {\tt GlobalSegMap} argument
! {\tt GSMap}.  The input {\tt INTEGER} arguments {\tt ngseg},
! {\tt comp\_id}, {\tt gsize} (again, valid only on the {\tt root}
! process) provide the {\tt GlobalSegMap} global segment count, component
! ID number, and global grid size, respectively.  The input argument
! {\tt my\_comm} is the F90 {\tt INTEGER} handle for the MPI communicator.

! If the argument gsize is present, use the root value to
! set GSMap%gsize and broadcast it.  If it is not present,
! this will be computed by summing the entries of GSM%length(:).
! Again, note that if one is storing halo points, the sum will
! produce a result larger than the actual global vector.  If
! halo points are to be used in the mapping we advise strongly
! that the user specify the value gsize as an argument.

=> MPI_COMM_RANK(my_comm, myID, ier)
if(myID == root) then
     GSMap%ngseg = ngseg
     GSMap%comp_id = comp_id
endif
=> MPI_BCAST(GSMap%ngseg, 1, MP_INTEGER, root, my_comm, ier)
=> MPI_BCAST(GSMap%comp_id, 1, MP_INTEGER, root, my_comm, ier)
if(myID == root) then
     GSMap%start(1:GSMap%ngseg) = start(1:GSMap%ngseg)
     GSMap%length(1:GSMap%ngseg) = length(1:GSMap%ngseg)
     GSMap%pe_loc(1:GSMap%ngseg) = pe_loc(1:GSMap%ngseg)
endif
=> MPI_BCAST(GSMap%start, GSMap%ngseg, MP_INTEGER, root, my_comm, ier)
=> MPI_BCAST(GSMap%length, GSMap%ngseg, MP_INTEGER, root, my_comm, ier)
=> MPI_BCAST(GSMap%pe_loc, GSMap%ngseg, MP_INTEGER, root, my_comm, ier)
if (present(gsize)) then
     if(myID == root) then
    GSMap%gsize = gsize
     endif
     call MPI_BCAST(GSMap%gsize, 1, MP_INTEGER, root, my_comm, ier)
     if(ier/=0) call MP_perr_die(myname_, 'MPI_BCAST(GSMap%gsize)', ier)
else
     GSMap%gsize = 0
     do i=1,GSMap%ngseg
    GSMap%gsize = GSMap%gsize + GSMap%length(i)
     end do
endif


Function gsize_(GSMap)

! !IROUTINE: gsize_ - Return the global vector size from the GlobalSegMap.
!
! !DESCRIPTION:
! The function {\tt gsize\_()} takes the input {\tt GlobalSegMap}
! arguement {\tt GSMap} and returns the global vector length stored
! in {\tt GlobalSegMap\%gsize}.

              gsize_=GSMap%gsize