[4775] | 1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 2 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 3 | !----------------------------------------------------------------------- |
---|
| 4 | ! CVS m_GlobalMap.F90,v 1.11 2004-04-21 22:47:09 jacob Exp |
---|
| 5 | ! CVS MCT_2_8_0 |
---|
| 6 | !BOP ------------------------------------------------------------------- |
---|
| 7 | ! |
---|
| 8 | ! !MODULE: m_GlobalMap - One-Dimensional Domain Decomposition Descriptor |
---|
| 9 | ! |
---|
| 10 | ! !DESCRIPTION: |
---|
| 11 | ! The {\tt GlobalMap} is a datatype used to store descriptors of a |
---|
| 12 | ! one-dimensional domain decomposition for a vector on an MPI communicator. |
---|
| 13 | ! It is defined with three assumptions: |
---|
| 14 | ! \begin{enumerate} |
---|
| 15 | ! \item Each process ID owns only one segment; |
---|
| 16 | ! \item No two segments in the decomposition overlap; and |
---|
| 17 | ! \item The segments are laid out in identical order to the MPI rank of |
---|
| 18 | ! each process participating in the decomposition. |
---|
| 19 | ! \end{enumerate} |
---|
| 20 | ! per process ID). It is the simpler of the two domain decomposition |
---|
| 21 | ! descriptors offerd by MCT (the other being the {\tt GlobalSegMap}). |
---|
| 22 | ! It consists of the following components: |
---|
| 23 | ! \begin{itemize} |
---|
| 24 | ! \item The MCT component identification number (see the module |
---|
| 25 | ! {\tt m\_MCTWorld} for more information about MCT's component model |
---|
| 26 | ! registry); |
---|
| 27 | ! \item The {\em global} number of elements in the distributed vector; |
---|
| 28 | ! \item The number of elements {\em stored locally}; |
---|
| 29 | ! \item The number of elements {\em stored on each process} on the |
---|
| 30 | ! communicator over which the vector is distributed; and |
---|
| 31 | ! \item The index of the elemnent {\em immediately before} the starting |
---|
| 32 | ! element of each local segment (this choice allows for direct use of |
---|
| 33 | ! this information with MPI's scatter and gather operations). We refer |
---|
| 34 | ! to this quantity as the {\em displacement} of the segment, a term used |
---|
| 35 | ! both here and in the definition of the MCT {\tt Navigator} datatype. |
---|
| 36 | ! \end{itemize} |
---|
| 37 | ! |
---|
| 38 | ! Both the segment displacement and length data are stored in arrays |
---|
| 39 | ! whose indices run from zero to $N-1$, where $N$ is the number of MPI |
---|
| 40 | ! processes on the communicator on which the {\tt GlobalMap} is defined. |
---|
| 41 | ! This is done so this information corresponds directly to the MPI process |
---|
| 42 | ! ID's on whihc the segments reside. |
---|
| 43 | ! |
---|
| 44 | ! This module contains the definition of the {\tt GlobalMap} datatype, |
---|
| 45 | ! all-processor and an on-root creation methods (both of which can be |
---|
| 46 | ! used to create a {\tt GlobalMap} on the local communicator), a creation |
---|
| 47 | ! method to create/propagate a {\tt GlobalMap} native to a remote |
---|
| 48 | ! communicator, a destruction method, and a variety of query methods. |
---|
| 49 | ! |
---|
| 50 | ! !INTERFACE: |
---|
| 51 | |
---|
| 52 | module m_GlobalMap |
---|
| 53 | |
---|
| 54 | ! !USES |
---|
| 55 | ! No external modules are used in the declaration section of this module. |
---|
| 56 | |
---|
| 57 | implicit none |
---|
| 58 | |
---|
| 59 | private ! except |
---|
| 60 | |
---|
| 61 | ! !PUBLIC TYPES: |
---|
| 62 | |
---|
| 63 | public :: GlobalMap ! The class data structure |
---|
| 64 | |
---|
| 65 | Type GlobalMap |
---|
| 66 | integer :: comp_id ! Component ID number |
---|
| 67 | integer :: gsize ! the Global size |
---|
| 68 | integer :: lsize ! my local size |
---|
| 69 | integer,dimension(:),pointer :: counts ! all local sizes |
---|
| 70 | integer,dimension(:),pointer :: displs ! PE ordered locations |
---|
| 71 | End Type GlobalMap |
---|
| 72 | |
---|
| 73 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
| 74 | |
---|
| 75 | public :: gsize |
---|
| 76 | public :: lsize |
---|
| 77 | public :: init |
---|
| 78 | public :: init_remote |
---|
| 79 | public :: clean |
---|
| 80 | public :: rank |
---|
| 81 | public :: bounds |
---|
| 82 | public :: comp_id |
---|
| 83 | |
---|
| 84 | interface gsize; module procedure gsize_; end interface |
---|
| 85 | interface lsize; module procedure lsize_; end interface |
---|
| 86 | interface init ; module procedure & |
---|
| 87 | initd_, & ! initialize from all PEs |
---|
| 88 | initr_ ! initialize from the root |
---|
| 89 | end interface |
---|
| 90 | interface init_remote; module procedure init_remote_; end interface |
---|
| 91 | interface clean; module procedure clean_; end interface |
---|
| 92 | interface rank ; module procedure rank_ ; end interface |
---|
| 93 | interface bounds; module procedure bounds_; end interface |
---|
| 94 | interface comp_id ; module procedure comp_id_ ; end interface |
---|
| 95 | |
---|
| 96 | ! !SEE ALSO: |
---|
| 97 | ! The MCT module m_MCTWorld for more information regarding component |
---|
| 98 | ! ID numbers. |
---|
| 99 | ! |
---|
| 100 | ! !REVISION HISTORY: |
---|
| 101 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 102 | ! 9Nov00 - J.W. Larson <larson@mcs.anl.gov> - added init_remote |
---|
| 103 | ! interface. |
---|
| 104 | ! 26Jan01 - J.W. Larson <larson@mcs.anl.gov> - added storage for |
---|
| 105 | ! component ID number GlobalMap%comp_id, and associated |
---|
| 106 | ! method comp_id_() |
---|
| 107 | !EOP ___________________________________________________________________ |
---|
| 108 | |
---|
| 109 | character(len=*),parameter :: myname='MCT::m_GlobalMap' |
---|
| 110 | |
---|
| 111 | contains |
---|
| 112 | |
---|
| 113 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 114 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 115 | !BOP ------------------------------------------------------------------- |
---|
| 116 | ! |
---|
| 117 | ! !IROUTINE: initd_ - Collective Creation on the Local Communicator |
---|
| 118 | ! |
---|
| 119 | ! !DESCRIPTION: |
---|
| 120 | ! This routine creates the {\tt GlobalMap} {\tt GMap} from distributed |
---|
| 121 | ! data spread across the MPI communicatior associated with the input |
---|
| 122 | ! {\tt INTEGER} handle {\tt comm}. The {\tt INTEGER} input argument |
---|
| 123 | ! {\tt comp\_id} is used to define the MCT component ID for {\tt GMap}. |
---|
| 124 | ! The input {\tt INTEGER} argument {\tt ln} is the number of elements |
---|
| 125 | ! in the local vector segment. |
---|
| 126 | ! |
---|
| 127 | ! !INTERFACE: |
---|
| 128 | |
---|
| 129 | subroutine initd_(GMap, comp_id, ln, comm) |
---|
| 130 | |
---|
| 131 | ! !USES: |
---|
| 132 | |
---|
| 133 | use m_mpif90 |
---|
| 134 | use m_die |
---|
| 135 | |
---|
| 136 | implicit none |
---|
| 137 | |
---|
| 138 | ! !INPUT PARAMETERS: |
---|
| 139 | |
---|
| 140 | integer, intent(in) :: comp_id ! Component ID |
---|
| 141 | integer, intent(in) :: ln ! the local size |
---|
| 142 | integer, intent(in) :: comm ! f90 MPI communicator |
---|
| 143 | ! handle |
---|
| 144 | |
---|
| 145 | ! !OUTPUT PARAMETERS: |
---|
| 146 | |
---|
| 147 | type(GlobalMap), intent(out) :: GMap |
---|
| 148 | |
---|
| 149 | ! !SEE ALSO: |
---|
| 150 | ! The MCT module m_MCTWorld for more information regarding component |
---|
| 151 | ! ID numbers. |
---|
| 152 | ! |
---|
| 153 | ! !REVISION HISTORY: |
---|
| 154 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 155 | !EOP ___________________________________________________________________ |
---|
| 156 | |
---|
| 157 | character(len=*),parameter :: myname_=myname//'::initd_' |
---|
| 158 | integer :: nPEs,myID,ier,l,i |
---|
| 159 | |
---|
| 160 | call MP_comm_size(comm,nPEs,ier) |
---|
| 161 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier) |
---|
| 162 | |
---|
| 163 | call MP_comm_rank(comm,myID,ier) |
---|
| 164 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier) |
---|
| 165 | |
---|
| 166 | allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier) |
---|
| 167 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
| 168 | |
---|
| 169 | #ifdef MALL_ON |
---|
| 170 | call mall_ci(size(transfer(GMap%counts,(/1/))),myname_) |
---|
| 171 | call mall_ci(size(transfer(GMap%displs,(/1/))),myname_) |
---|
| 172 | #endif |
---|
| 173 | |
---|
| 174 | call MPI_allgather(ln,1,MP_INTEGER,GMap%counts,1,MP_INTEGER,comm,ier) |
---|
| 175 | if(ier/=0) call MP_perr_die(myname_,'MPI_allgather()',ier) |
---|
| 176 | |
---|
| 177 | l=0 |
---|
| 178 | do i=0,nPEs-1 |
---|
| 179 | GMap%displs(i)=l |
---|
| 180 | l=l+GMap%counts(i) |
---|
| 181 | end do |
---|
| 182 | |
---|
| 183 | GMap%lsize=GMap%counts(myID) ! the local size |
---|
| 184 | GMap%gsize=l ! the global size |
---|
| 185 | GMap%comp_id = comp_id ! the component ID number |
---|
| 186 | |
---|
| 187 | end subroutine initd_ |
---|
| 188 | |
---|
| 189 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 190 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 191 | !BOP ------------------------------------------------------------------- |
---|
| 192 | ! |
---|
| 193 | ! !IROUTINE: initr_ Create a GlobalMap from the Root Process |
---|
| 194 | ! |
---|
| 195 | ! !DESCRIPTION: |
---|
| 196 | ! This routine creates the {\tt GlobalMap} {\tt GMap}, and propagates |
---|
| 197 | ! it to all processes on the communicator associated with the MPI |
---|
| 198 | ! {\tt INTEGER} handle {\tt comm}. The input {\tt INTEGER} arguments |
---|
| 199 | ! {\tt comp\_id} (the MCT component ID number) and {\tt lns(:)} need |
---|
| 200 | ! only be valid on the process whose rank is equal to {\tt root} on |
---|
| 201 | ! {\tt comm}. The array {\tt lns(:)} should have length equal to the |
---|
| 202 | ! number of processes on {\tt comm}, and contains the length of each |
---|
| 203 | ! local segment. |
---|
| 204 | ! |
---|
| 205 | ! !INTERFACE: |
---|
| 206 | |
---|
| 207 | subroutine initr_(GMap, comp_id, lns, root, comm) |
---|
| 208 | |
---|
| 209 | ! !USES: |
---|
| 210 | |
---|
| 211 | use m_mpif90 |
---|
| 212 | use m_die |
---|
| 213 | use m_stdio |
---|
| 214 | |
---|
| 215 | implicit none |
---|
| 216 | |
---|
| 217 | ! !INPUT PARAMETERS: |
---|
| 218 | |
---|
| 219 | integer, intent(in) :: comp_id ! component ID number |
---|
| 220 | integer, dimension(:), intent(in) :: lns ! segment lengths |
---|
| 221 | integer, intent(in) :: root ! root process ID |
---|
| 222 | integer, intent(in) :: comm ! communicator ID |
---|
| 223 | |
---|
| 224 | ! !OUTPUT PARAMETERS: |
---|
| 225 | |
---|
| 226 | type(GlobalMap), intent(out) :: GMap |
---|
| 227 | |
---|
| 228 | ! !SEE ALSO: |
---|
| 229 | ! The MCT module m_MCTWorld for more information regarding component |
---|
| 230 | ! ID numbers. |
---|
| 231 | ! |
---|
| 232 | ! !REVISION HISTORY: |
---|
| 233 | ! 29May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 234 | !EOP ___________________________________________________________________ |
---|
| 235 | |
---|
| 236 | character(len=*),parameter :: myname_=myname//'::initr_' |
---|
| 237 | integer :: nPEs,myID,ier,l,i |
---|
| 238 | |
---|
| 239 | call MP_comm_size(comm,nPEs,ier) |
---|
| 240 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier) |
---|
| 241 | |
---|
| 242 | call MP_comm_rank(comm,myID,ier) |
---|
| 243 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier) |
---|
| 244 | |
---|
| 245 | allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier) |
---|
| 246 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
| 247 | |
---|
| 248 | #ifdef MALL_ON |
---|
| 249 | call mall_ci(size(transfer(GMap%counts,(/1/))),myname_) |
---|
| 250 | call mall_ci(size(transfer(GMap%displs,(/1/))),myname_) |
---|
| 251 | #endif |
---|
| 252 | |
---|
| 253 | if(myID == root) then |
---|
| 254 | if(size(lns(:)) /= nPEs) then |
---|
| 255 | write(stderr,'(2a,2(a,i4))') myname_, & |
---|
| 256 | ': _root_ argument error', & |
---|
| 257 | ', size(lns) =',size(lns), & |
---|
| 258 | ', nPEs =',nPEs |
---|
| 259 | call die(myname_) |
---|
| 260 | endif |
---|
| 261 | |
---|
| 262 | GMap%counts(:)=lns(:) |
---|
| 263 | endif |
---|
| 264 | |
---|
| 265 | call MPI_bcast(GMap%counts, nPEs, MP_INTEGER, root, comm, ier) |
---|
| 266 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier) |
---|
| 267 | |
---|
| 268 | ! on each process, use GMap%counts(:) to compute GMap%displs(:) |
---|
| 269 | |
---|
| 270 | l=0 |
---|
| 271 | do i=0,nPEs-1 |
---|
| 272 | GMap%displs(i)=l |
---|
| 273 | l=l+GMap%counts(i) |
---|
| 274 | end do |
---|
| 275 | |
---|
| 276 | GMap%lsize=GMap%counts(myID) ! the local size |
---|
| 277 | GMap%gsize=l ! the global size |
---|
| 278 | |
---|
| 279 | ! finally, set and broadcast the component ID number GMap%comp_id |
---|
| 280 | |
---|
| 281 | if(myID == root) GMap%comp_id = comp_id |
---|
| 282 | |
---|
| 283 | call MPI_bcast(GMap%comp_id,1,MP_INTEGER,root,comm,ier) |
---|
| 284 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier) |
---|
| 285 | |
---|
| 286 | end subroutine initr_ |
---|
| 287 | |
---|
| 288 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 289 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 290 | !BOP ------------------------------------------------------------------- |
---|
| 291 | ! |
---|
| 292 | ! !IROUTINE: init_remote_ Initialize Remote GlobalMap from the Root |
---|
| 293 | ! |
---|
| 294 | ! !DESCRIPTION: |
---|
| 295 | ! This routine creates and propagates across the local communicator a |
---|
| 296 | ! {\tt GlobalMap} associated with a remote component. The controlling |
---|
| 297 | ! process in this operation has MPI process ID defined by the input |
---|
| 298 | ! {\tt INTEGER} argument {\tt my\_root}, and its MPI communinicator |
---|
| 299 | ! is defined by the input {\tt INTEGER} argument {\tt my\_comm}. The |
---|
| 300 | ! input {\tt INTEGER} argument {\tt remote\_npes} is the number of MPI |
---|
| 301 | ! processes on the remote component's communicator (which need be valid |
---|
| 302 | ! only on the process {\tt my\_root}). The input the {\tt INTEGER} |
---|
| 303 | ! array {\tt remote\_lns(:)}, and the {\tt INTEGER} argument |
---|
| 304 | ! {\tt remote\_comp\_id} need only be valid on the process |
---|
| 305 | ! whose rank on the communicator {\tt my\_comm} is {\tt my\_root}. The |
---|
| 306 | ! argument {\tt remote\_lns(:)} defines the vector segment length on each |
---|
| 307 | ! process of the remote component's communicator, and the argument |
---|
| 308 | ! {\tt remote\_comp\_id} defines the remote component's ID number in |
---|
| 309 | ! the MCT component registry {\tt MCTWorld}. |
---|
| 310 | ! |
---|
| 311 | ! !INTERFACE: |
---|
| 312 | |
---|
| 313 | subroutine init_remote_(GMap, remote_lns, remote_npes, my_root, & |
---|
| 314 | my_comm, remote_comp_id) |
---|
| 315 | ! !USES: |
---|
| 316 | |
---|
| 317 | use m_mpif90 |
---|
| 318 | use m_die |
---|
| 319 | use m_stdio |
---|
| 320 | |
---|
| 321 | implicit none |
---|
| 322 | |
---|
| 323 | ! !INPUT PARAMETERS: |
---|
| 324 | |
---|
| 325 | integer, dimension(:), intent(in) :: remote_lns |
---|
| 326 | integer, intent(in) :: remote_npes |
---|
| 327 | integer, intent(in) :: my_root |
---|
| 328 | integer, intent(in) :: my_comm |
---|
| 329 | integer, intent(in) :: remote_comp_id |
---|
| 330 | |
---|
| 331 | ! !OUTPUT PARAMETERS: |
---|
| 332 | |
---|
| 333 | type(GlobalMap), intent(out) :: GMap |
---|
| 334 | |
---|
| 335 | ! !SEE ALSO: |
---|
| 336 | ! The MCT module m_MCTWorld for more information regarding component |
---|
| 337 | ! ID numbers. |
---|
| 338 | ! |
---|
| 339 | ! !REVISION HISTORY: |
---|
| 340 | ! 8Nov00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype |
---|
| 341 | ! 26Jan01 - J.W. Larson <larson@mcs.anl.gov> - slight change--remote |
---|
| 342 | ! communicator is replaced by remote component ID number |
---|
| 343 | ! in argument remote_comp_id. |
---|
| 344 | !EOP ___________________________________________________________________ |
---|
| 345 | |
---|
| 346 | character(len=*),parameter :: myname_=myname//'::init_remote_' |
---|
| 347 | integer :: nPEs,myID,ier,l,i |
---|
| 348 | |
---|
| 349 | |
---|
| 350 | ! Which processor am I on communicator my_comm? Store |
---|
| 351 | ! the answer in myID: |
---|
| 352 | |
---|
| 353 | call MP_comm_rank(my_comm, myID, ier) |
---|
| 354 | if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier) |
---|
| 355 | |
---|
| 356 | ! allocate counts and displacements component arrays |
---|
| 357 | ! for the sake of compactness, store the value of remote_npes |
---|
| 358 | ! in the more tersely named variable nPEs. |
---|
| 359 | |
---|
| 360 | if(myID == my_root) nPEs = remote_npes |
---|
| 361 | |
---|
| 362 | call MPI_bcast(nPEs, 1, MP_INTEGER, my_root, my_comm, ier) |
---|
| 363 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast(nPEs...)',ier) |
---|
| 364 | |
---|
| 365 | allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier) |
---|
| 366 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
| 367 | |
---|
| 368 | #ifdef MALL_ON |
---|
| 369 | call mall_ci(size(transfer(GMap%counts,(/1/))),myname_) |
---|
| 370 | call mall_ci(size(transfer(GMap%displs,(/1/))),myname_) |
---|
| 371 | #endif |
---|
| 372 | |
---|
| 373 | ! On the Root processor, check the size of remote_lns(:) |
---|
| 374 | ! to see it is equal to nPEs, the number of remote processes, |
---|
| 375 | ! then store it as GMap%counts and broadcast it. |
---|
| 376 | |
---|
| 377 | if(myID == my_root) then |
---|
| 378 | if(size(remote_lns(:)) /= nPEs) then |
---|
| 379 | write(stderr,'(2a,2(a,i4))') myname_, & |
---|
| 380 | ': _root_ argument error', & |
---|
| 381 | ', size(remote_lns) =',size(remote_lns), & |
---|
| 382 | ', nPEs =',nPEs |
---|
| 383 | call die(myname_) |
---|
| 384 | endif |
---|
| 385 | |
---|
| 386 | GMap%counts(:)=remote_lns(:) |
---|
| 387 | endif |
---|
| 388 | |
---|
| 389 | call MPI_bcast(GMap%counts, nPEs, MP_INTEGER, my_root, my_comm, ier) |
---|
| 390 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier) |
---|
| 391 | |
---|
| 392 | ! Now, on each processor of my_comm, compute from |
---|
| 393 | ! GMap%counts(:) the entries of GMap%displs(:) |
---|
| 394 | |
---|
| 395 | l=0 |
---|
| 396 | do i=0,nPEs-1 |
---|
| 397 | GMap%displs(i)=l |
---|
| 398 | l=l+GMap%counts(i) |
---|
| 399 | end do |
---|
| 400 | |
---|
| 401 | GMap%lsize = -1 ! In this case, the local size is invalid!!! |
---|
| 402 | GMap%gsize = l ! the global size |
---|
| 403 | |
---|
| 404 | ! Finally, set GMap's component ID (recall only the value on |
---|
| 405 | ! process my_root is valid). |
---|
| 406 | |
---|
| 407 | if(myID == my_root) GMap%comp_id = remote_comp_id |
---|
| 408 | call MPI_bcast(GMap%comp_id, 1, MP_INTEGER, my_root, my_comm,ier) |
---|
| 409 | if(ier/=0) call MP_perr_die(myname_,'MPI_bcast(GMap%comp_id...)',ier) |
---|
| 410 | |
---|
| 411 | end subroutine init_remote_ |
---|
| 412 | |
---|
| 413 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 414 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 415 | !BOP ------------------------------------------------------------------- |
---|
| 416 | ! |
---|
| 417 | ! !IROUTINE: clean_ - Destroy a GlobalMap |
---|
| 418 | ! |
---|
| 419 | ! !DESCRIPTION: |
---|
| 420 | ! This routine deallocates all allocated memory associated with the |
---|
| 421 | ! input/output {\tt GlobalMap} argument {\tt GMap}, and sets to zero |
---|
| 422 | ! all of its statically defined components. The success (failure) of |
---|
| 423 | ! this operation is signified by the zero (non-zero) value of the |
---|
| 424 | ! optional output {\tt INTEGER} argument {\tt stat}. |
---|
| 425 | ! |
---|
| 426 | ! !INTERFACE: |
---|
| 427 | |
---|
| 428 | subroutine clean_(GMap, stat) |
---|
| 429 | |
---|
| 430 | ! !USES: |
---|
| 431 | |
---|
| 432 | use m_die |
---|
| 433 | |
---|
| 434 | implicit none |
---|
| 435 | |
---|
| 436 | ! !INPUT/OUTPUT PARAMETERS: |
---|
| 437 | |
---|
| 438 | type(GlobalMap), intent(inout) :: GMap |
---|
| 439 | |
---|
| 440 | ! !OUTPUT PARAMETERS: |
---|
| 441 | |
---|
| 442 | integer, optional, intent(out) :: stat |
---|
| 443 | |
---|
| 444 | ! !REVISION HISTORY: |
---|
| 445 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 446 | ! 26Jan01 - J. Larson <larson@mcs.anl.gov> incorporated comp_id. |
---|
| 447 | ! 1Mar02 - E.T. Ong <eong@mcs.anl.gov> removed the die to prevent |
---|
| 448 | ! crashes and added stat argument. |
---|
| 449 | !EOP ___________________________________________________________________ |
---|
| 450 | |
---|
| 451 | character(len=*),parameter :: myname_=myname//'::clean_' |
---|
| 452 | integer :: ier |
---|
| 453 | |
---|
| 454 | deallocate(GMap%counts,GMap%displs,stat=ier) |
---|
| 455 | |
---|
| 456 | if(present(stat)) then |
---|
| 457 | stat=ier |
---|
| 458 | else |
---|
| 459 | if(ier /= 0) call warn(myname_,'deallocate(GMap%...)',ier) |
---|
| 460 | endif |
---|
| 461 | |
---|
| 462 | if(ier == 0) then |
---|
| 463 | |
---|
| 464 | #ifdef MALL_ON |
---|
| 465 | call mall_co(size(transfer(GMap%counts,(/1/))),myname_) |
---|
| 466 | call mall_co(size(transfer(GMap%displs,(/1/))),myname_) |
---|
| 467 | #endif |
---|
| 468 | |
---|
| 469 | endif |
---|
| 470 | |
---|
| 471 | GMap%lsize = 0 |
---|
| 472 | GMap%gsize = 0 |
---|
| 473 | GMap%comp_id = 0 |
---|
| 474 | |
---|
| 475 | end subroutine clean_ |
---|
| 476 | |
---|
| 477 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 478 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 479 | !BOP ------------------------------------------------------------------- |
---|
| 480 | ! |
---|
| 481 | ! !IROUTINE: lsize_ - Return Local Segment Length |
---|
| 482 | ! |
---|
| 483 | ! !DESCRIPTION: |
---|
| 484 | ! This {\tt INTEGER} function returns the length of the local vector |
---|
| 485 | ! segment as defined by the input {\tt GlobalMap} argument {\tt GMap}. |
---|
| 486 | |
---|
| 487 | ! !INTERFACE: |
---|
| 488 | |
---|
| 489 | integer function lsize_(GMap) |
---|
| 490 | |
---|
| 491 | ! !USES: |
---|
| 492 | |
---|
| 493 | implicit none |
---|
| 494 | |
---|
| 495 | ! !INPUT PARAMETERS: |
---|
| 496 | |
---|
| 497 | type(GlobalMap), intent(in) :: GMap |
---|
| 498 | |
---|
| 499 | ! !REVISION HISTORY: |
---|
| 500 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 501 | !EOP ___________________________________________________________________ |
---|
| 502 | |
---|
| 503 | character(len=*),parameter :: myname_=myname//'::lsize_' |
---|
| 504 | |
---|
| 505 | lsize_=GMap%lsize |
---|
| 506 | |
---|
| 507 | end function lsize_ |
---|
| 508 | |
---|
| 509 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 510 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 511 | !BOP ------------------------------------------------------------------- |
---|
| 512 | ! |
---|
| 513 | ! !IROUTINE: gsize_ - Return Global Vector Length |
---|
| 514 | ! |
---|
| 515 | ! !DESCRIPTION: |
---|
| 516 | ! This {\tt INTEGER} function returns the global length of a vector |
---|
| 517 | ! that is decomposed according to the input {\tt GlobalMap} argument |
---|
| 518 | ! {\tt GMap}. |
---|
| 519 | ! |
---|
| 520 | ! !INTERFACE: |
---|
| 521 | |
---|
| 522 | integer function gsize_(GMap) |
---|
| 523 | |
---|
| 524 | ! !USES: |
---|
| 525 | |
---|
| 526 | implicit none |
---|
| 527 | |
---|
| 528 | ! !INPUT PARAMETERS: |
---|
| 529 | |
---|
| 530 | type(GlobalMap), intent(in) :: GMap |
---|
| 531 | |
---|
| 532 | |
---|
| 533 | ! !REVISION HISTORY: |
---|
| 534 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 535 | !EOP ___________________________________________________________________ |
---|
| 536 | |
---|
| 537 | character(len=*),parameter :: myname_=myname//'::gsize_' |
---|
| 538 | |
---|
| 539 | gsize_=GMap%gsize |
---|
| 540 | |
---|
| 541 | end function gsize_ |
---|
| 542 | |
---|
| 543 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 544 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 545 | !BOP ------------------------------------------------------------------- |
---|
| 546 | ! |
---|
| 547 | ! !IROUTINE: rank_ - Process ID Location of a Given Vector Element |
---|
| 548 | ! |
---|
| 549 | ! !DESCRIPTION: |
---|
| 550 | ! This routine uses the input {\tt GlobalMap} argument {\tt GMap} to |
---|
| 551 | ! determine the process ID (on the communicator on which {\tt GMap} was |
---|
| 552 | ! defined) of the vector element with global index {\tt i\_g}. This |
---|
| 553 | ! process ID is returned in the output {\tt INTEGER} argument {\tt rank}. |
---|
| 554 | ! |
---|
| 555 | ! !INTERFACE: |
---|
| 556 | |
---|
| 557 | subroutine rank_(GMap, i_g, rank) |
---|
| 558 | |
---|
| 559 | ! !USES: |
---|
| 560 | |
---|
| 561 | implicit none |
---|
| 562 | |
---|
| 563 | ! !INPUT PARAMETERS: |
---|
| 564 | |
---|
| 565 | type(GlobalMap), intent(in) :: GMap |
---|
| 566 | integer, intent(in) :: i_g |
---|
| 567 | |
---|
| 568 | ! !OUTPUT PARAMETERS: |
---|
| 569 | |
---|
| 570 | integer, intent(out) :: rank |
---|
| 571 | |
---|
| 572 | ! !REVISION HISTORY: |
---|
| 573 | ! 5May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
| 574 | !EOP ___________________________________________________________________ |
---|
| 575 | |
---|
| 576 | character(len=*),parameter :: myname_=myname//'::rank_' |
---|
| 577 | integer :: i,ilc,ile |
---|
| 578 | |
---|
| 579 | rank=-1 ! if nowhere fits |
---|
| 580 | do i=0,size(GMap%displs)-1 |
---|
| 581 | ilc=GMap%displs(i) |
---|
| 582 | ile=ilc+GMap%counts(i) |
---|
| 583 | |
---|
| 584 | ! If i_g in (ilc,ile]. Note that i_g := [1:..] |
---|
| 585 | |
---|
| 586 | if(ilc < i_g .and. i_g <= ile) then |
---|
| 587 | rank=i |
---|
| 588 | return |
---|
| 589 | endif |
---|
| 590 | end do |
---|
| 591 | |
---|
| 592 | end subroutine rank_ |
---|
| 593 | |
---|
| 594 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 595 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 596 | !BOP ------------------------------------------------------------------- |
---|
| 597 | ! |
---|
| 598 | ! !IROUTINE: bounds_ - First/Last Global Indicies for a Process' Segment |
---|
| 599 | ! |
---|
| 600 | ! !DESCRIPTION: |
---|
| 601 | ! This routine takes as input a process ID (defined by the input |
---|
| 602 | ! {\tt INTEGER} argument {\tt pe\_no}), examines the input {\tt GlobalMap} |
---|
| 603 | ! argument {\tt GMap}, and returns the global indices for the first and |
---|
| 604 | ! last elements of the segment owned by this process in the output |
---|
| 605 | ! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd}, respectively. |
---|
| 606 | ! |
---|
| 607 | ! !INTERFACE: |
---|
| 608 | |
---|
| 609 | subroutine bounds_(GMap, pe_no, lbnd, ubnd) |
---|
| 610 | |
---|
| 611 | ! !USES: |
---|
| 612 | |
---|
| 613 | implicit none |
---|
| 614 | |
---|
| 615 | ! !INPUT PARAMETERS: |
---|
| 616 | |
---|
| 617 | type(GlobalMap), intent(in) :: GMap |
---|
| 618 | integer, intent(in) :: pe_no |
---|
| 619 | |
---|
| 620 | ! !OUTPUT PARAMETERS: |
---|
| 621 | |
---|
| 622 | integer, intent(out) :: lbnd |
---|
| 623 | integer, intent(out) :: ubnd |
---|
| 624 | |
---|
| 625 | ! !REVISION HISTORY: |
---|
| 626 | ! 30Jan01 - J. Larson <larson@mcs.anl.gov> - initial code |
---|
| 627 | !EOP ___________________________________________________________________ |
---|
| 628 | |
---|
| 629 | character(len=*),parameter :: myname_=myname//'::bounds_' |
---|
| 630 | |
---|
| 631 | lbnd = GMap%displs(pe_no) + 1 |
---|
| 632 | ubnd = lbnd + GMap%counts(pe_no) - 1 |
---|
| 633 | |
---|
| 634 | end subroutine bounds_ |
---|
| 635 | |
---|
| 636 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
| 637 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
| 638 | !BOP ------------------------------------------------------------------- |
---|
| 639 | ! |
---|
| 640 | ! !IROUTINE: comp_id_ - Return the Component ID Number |
---|
| 641 | ! |
---|
| 642 | ! !DESCRIPTION: |
---|
| 643 | ! This {\tt INTEGER} query function returns the MCT component ID number |
---|
| 644 | ! stored in the input {\tt GlobalMap} argument {\tt GMap}. |
---|
| 645 | ! |
---|
| 646 | ! !INTERFACE: |
---|
| 647 | |
---|
| 648 | integer function comp_id_(GMap) |
---|
| 649 | |
---|
| 650 | ! !USES: |
---|
| 651 | |
---|
| 652 | implicit none |
---|
| 653 | |
---|
| 654 | ! !INPUT PARAMETERS: |
---|
| 655 | |
---|
| 656 | type(GlobalMap), intent(in) :: GMap |
---|
| 657 | |
---|
| 658 | ! !SEE ALSO: |
---|
| 659 | ! The MCT module m_MCTWorld for more information regarding component |
---|
| 660 | ! ID numbers. |
---|
| 661 | ! |
---|
| 662 | ! !REVISION HISTORY: |
---|
| 663 | ! 25Jan02 - J. Larson <larson@mcs.anl.gov> - initial version |
---|
| 664 | !EOP ___________________________________________________________________ |
---|
| 665 | |
---|
| 666 | character(len=*),parameter :: myname_=myname//'::comp_id_' |
---|
| 667 | |
---|
| 668 | comp_id_ = GMap%comp_id |
---|
| 669 | |
---|
| 670 | end function comp_id_ |
---|
| 671 | |
---|
| 672 | end module m_GlobalMap |
---|