SourceIMP/utilities/RocfracPrep/NewCommList.f90

Go to the documentation of this file.

!*********************************************************************
!* Illinois Open Source License                                      *
!*                                                                   *
!* University of Illinois/NCSA                                       * 
!* Open Source License                                               *
!*                                                                   *
!* Copyright@2008, University of Illinois.  All rights reserved.     *
!*                                                                   *
!*  Developed by:                                                    *
!*                                                                   *
!*     Center for Simulation of Advanced Rockets                     *
!*                                                                   *
!*     University of Illinois                                        *
!*                                                                   *
!*     www.csar.uiuc.edu                                             *
!*                                                                   *
!* Permission is hereby granted, free of charge, to any person       *
!* obtaining a copy of this software and associated documentation    *
!* files (the "Software"), to deal with the Software without         *
!* restriction, including without limitation the rights to use,      *
!* copy, modify, merge, publish, distribute, sublicense, and/or      *
!* sell copies of the Software, and to permit persons to whom the    *
!* Software is furnished to do so, subject to the following          *
!* conditions:                                                       *
!*                                                                   *
!*                                                                   *
!* @ Redistributions of source code must retain the above copyright  * 
!*   notice, this list of conditions and the following disclaimers.  *
!*                                                                   * 
!* @ Redistributions in binary form must reproduce the above         *
!*   copyright notice, this list of conditions and the following     *
!*   disclaimers in the documentation and/or other materials         *
!*   provided with the distribution.                                 *
!*                                                                   *
!* @ Neither the names of the Center for Simulation of Advanced      *
!*   Rockets, the University of Illinois, nor the names of its       *
!*   contributors may be used to endorse or promote products derived * 
!*   from this Software without specific prior written permission.   *
!*                                                                   *
!* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
!* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
!* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
!* NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
!* COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       * 
!* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
!* ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
!* USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
!*********************************************************************
!* Please acknowledge The University of Illinois Center for          *
!* Simulation of Advanced Rockets in works and publications          *
!* resulting from this software or its derivatives.                  *
!*********************************************************************
SUBROUTINE newcommlist(NumEl, NumNP, NumProcs, NumVertex, &
     nodeconn,elpart,numprocpernd,procndlist,maxnumberofprocstosharenode,&
     numelperproc,numndperproc)

  USE commglobal
  USE linked_list2


  IMPLICIT NONE

  INTEGER :: i, j, k, m, npart,icnt

  INTEGER :: numel
  INTEGER :: numnp 
  INTEGER :: numprocs
  INTEGER :: numvertex
  integer :: maxnumberofprocstosharenode

  INTEGER, DIMENSION(1:NumVertex,1:NumEl) :: nodeconn
  INTEGER, DIMENSION(1:NumEl) :: elpart
  INTEGER, DIMENSION(1:NumNP) ::  numprocpernd ! NumProcPerNd
  
  INTEGER, DIMENSION(1:NumNP,1:MaxNumberOfProcsToShareNode) :: procndlist
  INTEGER, DIMENSION(1:NumProcs) :: numelperproc, numndperproc
  INTEGER :: locnodenum, elid
  LOGICAL :: debug = .true.
  TYPE proclist
     INTEGER, DIMENSION(:), POINTER :: proc_list
  END TYPE proclist
  TYPE(proclist), ALLOCATABLE, DIMENSION(:) :: node


  INTEGER, ALLOCATABLE, DIMENSION(:) :: nproc_neigh_lst

  TYPE(procelemlist_data_ptr), pointer :: ptr

  ALLOCATE(id_sendto(1:numprocs,1:numprocs))

  id_sendto(1:numprocs,1:numprocs)%num_border_comm = 0


!         Here's a quick way to build communication lists in any
! FEM-type program.  There are  e  elements,  p  processors,
! and  n  nodes.  When I write that a table maps foo->bar,
! I mean table[foo] .eq. bar

! 1.) Partition the elements (using, e.g. metis).  This will
!     give you a table mapping element->processor.

! 2.) Build a list of the elements on each processor, by going
! through the element->processor table once, adding each element
! to the processor's local element list.  Time is O(e).

! Initialize list

  allocate(procelemlist(1:numprocs))
  DO i = 1, numprocs
     nullify(procelemlist(i)%head,procelemlist(i)%tail)
  enddo

! Build up list (add to stack)
  DO i = 1, numel
     npart = elpart(i)
     allocate(procelem_item)
     procelem_item%GlbElNum = i
     CALL add_procelemlist(procelem_item,procelemlist(npart)%head,procelemlist(npart)%tail)
  ENDDO


! 3.) Build a list of the nodes on each processor.  The way
! you do this is critical:
!         -First, build an emtpy node->processors table, to
! store a list of processors that touch each node.  Time is O(n).
!         -For each processor, for each local element,
! add this processor to all the element's nodes'
! processor lists (if it's not already in the list).
! The nodes' processor lists will be very short
! (almost always 0 or 1), so this step will be O(n).
!         -Go through the node->processors table, and
! add each node to all its adjacent processors.
! Nearly all node->processors lists have length 1, so
! this step is also O(n).

  numprocpernd(:) = 0

  DO i = 1, numprocs ! Number of processors
     numelperproc(i) = 0 ! Get_Len_ProcElemList(ProcElemList_head(i)) ! length of linked list, i.e. number of elements per processor

     ptr => procelemlist(i)%head
 
     DO WHILE(ASSOCIATED(ptr))

        numelperproc(i) =  numelperproc(i) + 1

        elid = ptr%GlbElNum

        DO k = 1, numvertex
           locnodenum = nodeconn(k,elid)
           DO m = 1, numprocpernd(locnodenum)
              IF(procndlist(locnodenum,m).EQ.i)THEN
                 goto 2
              ENDIF
           ENDDO
           numprocpernd(locnodenum) = numprocpernd(locnodenum) + 1
           IF(numprocpernd(locnodenum).GT.maxnumberofprocstosharenode)THEN
              print*,'Error in NewCommlist'
              print*,'Greater then ',maxnumberofprocstosharenode, &
                   ' processors share a node on the boundary'
              print*,'Increase MaxNumberOfProcsToShareNode'
              print*,'MaxNumberOfProcsToShareNode =', maxnumberofprocstosharenode
              print*,' Needed Size= ', numprocpernd(locnodenum)
              print*,'Stopping'
              stop
           endif
           procndlist(locnodenum,numprocpernd(locnodenum)) = i
           numndperproc(i) = numndperproc(i) + 1
2          CONTINUE
        ENDDO
        
        ptr => ptr%next

     ENDDO
  ENDDO

! 4.) Build the communication lists.  We can re-use the node->processors
! table we built before-- go through the table, and for each node:
!         -If the processor list for this node has length 1 (usual case),
! the node is local to the processor and never needs to be sent anywhere.
!         -If the length is greater than 1, the node is shared
! and you add it to the comm. lists for each listed processor.
! Time for this step is O(n).
  DO i = 1, numprocs
     DO j = 1, numprocs
        nullify(id_sendto(i,j)%comm_head )
        nullify(id_sendto(i,j)%comm_tail )
     enddo
  enddo

  DO i = 1, numnp
     IF(numprocpernd(i).NE.1)THEN
        DO j = 1, numprocpernd(i)
           DO k = 1, numprocpernd(i)
              IF(k.NE.j) CALL addcommnd(id_sendto(procndlist(i,j),procndlist(i,k)),i)
           ENDDO
        ENDDO
     ENDIF
  ENDDO

!!$  ALLOCATE(nproc_neigh_lst(1:NumProcs))
!!$  nproc_neigh_lst(1:NumProcs) = 0
!!$  DO i = 1, NumProcs
!!$!
!!$!     Determine the neighbor of processors 'i' is communicating with.
!!$!     
!!$     DO j = 1,NumProcs
!!$        IF(ID_sendto(i,j)%num_border_comm.NE.0) &
!!$             nproc_neigh_lst(i) = nproc_neigh_lst(i) + 1
!!$     ENDDO
!!$
!!$     WRITE(4000+i-1,*) nproc_neigh_lst(i)
!!$
!!$
!!$     
!!$     DO j = 1, NumProcs            ! receiving processor
!!$        IF(ID_sendto(j,i)%num_border_comm.NE.0)THEN
!!$!     Number of nodes that need to be communicated for R_in calculation
!!$           WRITE(4000+i-1,*) j-1,ID_sendto(j,i)%num_border_comm ! common
!!$!     List of nodes that need to be communicated for R_in calculation
!!$           CALL print_comm_list(ID_sendto(j,i))
!!$        ENDIF
!!$     ENDDO
!!$
!!$  ENDDO

! That's it-- total time is O(n+e), as long as most nodes and
! elements are not shared.  Note that the node->processors
! table we build in 3 is critical to the performance of both
! 3 and 4.  You could use a simpler implementation for step 3,
! such as:
!         for each processor; for each element; add the
! nodes around the element to the processor's node list
! (if it's not already there).
! 

! This alternate step 3 actually runs slower, because
! you have to check the processor's long node list for
! duplicates [it's O(p*(n/p)^2)].  Worse yet, 4 becomes
! horrifically expensive without a node->processors table--
! because you have to check if every node is shared,
! by running through all other processor's nodes, it's O(n^2)!
!    
! For  n = 10 million nodes, n^2 is unbelievably painful--
! 100 trillion.  The node->processors table, by contrast, can easily be
! done (in C) with about 12 bytes of memory per node (a processor #,
! a processor-local node #, and a rarely-used next pointer), almost
! all allocated contiguously.
! The node->processors table is the way to go for neighbor lists.




END SUBROUTINE newcommlist