MESH_PARTITIONING.f90

Go to the documentation of this file.

!    Copyright (C) 2012 The SPEED FOUNDATION
!    Author: Ilario Mazzieri
!
!    This file is part of SPEED.
!
!    SPEED is free software; you can redistribute it and/or modify it
!    under the terms of the GNU Affero General Public License as
!    published by the Free Software Foundation, either version 3 of the
!    License, or (at your option) any later version.
!
!    SPEED is distributed in the hope that it will be useful, but
!    WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!    Affero General Public License for more details.
!
!    You should have received a copy of the GNU Affero General Public License
!    along with SPEED.  If not, see <http://www.gnu.org/licenses/>.
 
 
 
      subroutine mesh_partitioning(mpi_file,nelem,nnode,nparts,conn,w_yn)
 
 
      implicit none
      
 
      character*70 :: mpi_file,u_name
      integer*4 :: ie,i,ic,u_mpi, w_yn, trash
      integer*4 :: ncommon, objval, edgecut
 
      integer*4, intent(inout) :: nelem, nnode, nparts
      integer*4, dimension(nelem,9), intent(in) :: conn
 
      integer*4, dimension(nnode) :: npart
      integer*4, dimension(nelem) :: epart
      integer*4, dimension(nelem) :: vwgt
 
      integer*4, pointer :: vsize(:) => null() 
 
      integer*4, dimension(nelem+1) :: eptr
      integer*4, dimension(nelem*8) :: eind
            
      integer*4 :: options(40) ! see METIS_NOPTIONS in metis.h
      integer*4, parameter :: METIS_OPTION_PTYPE = 1, metis_option_objtype = 2, metis_option_ctype = 3, &
                              metis_option_iptype = 4, metis_option_rtype = 5, metis_option_dbglvl = 6, &
                              metis_option_niter = 7, metis_option_ncuts = 8, metis_option_seed = 9, &
                              metis_option_no2hop = 10, &
                              metis_option_minconn = 11, metis_option_contig = 12, metis_option_compress = 13, &
                              metis_option_ccorder = 14, metis_option_pfactor = 15, metis_option_nseps = 16, &
                              metis_option_ufactor = 17, metis_option_numbering = 18
 
      real*8, pointer :: tpwgts(:) => null() 
 
      eptr(1) = 1
      ic = 1
      do ie = 1, nelem
         eptr(ie+1) = eptr(ie) + 8 
         do i = 2, 9
            eind(ic) = conn(ie,i)
            ic = ic +1
         enddo
      enddo
 
     eptr = eptr -1
     eind = eind - 1
 
     !!!----------   METIS-4.0.3  ------------------------------------!!!
      eind = eind +1
      call metis_partmeshdual(nelem,nnode,eind,3,1,nparts,edgecut,&
                              epart,npart)
      epart = epart - 1
 
     !!!----------   METIS-5.1.0  ------------------------------------!!!
     !ncommon = 4 
     !eptr = eptr + 1
     !eind = eind + 1
     !if(w_yn .eq. 0) then
     !   vwgt = 1
     !else
     !   u_name = 'element.wgt'
     !   u_mpi = 40                                 
     !   open(u_mpi,file=u_name)        
     !   read(u_mpi,*) nelem
     !   
     !   do i = 1, nelem
     !          read(u_mpi,*) trash, vwgt(i)
     !   enddo
     !   close(u_mpi)
     !endif     
 
     !! Setting the Fortran numbering scheme
     !call metis_setdefaultoptions(options)  !INPUT
     !options(metis_option_numbering) = 1
                              
     !call metis_partmeshdual(nelem, nnode, eptr, eind, vwgt, vsize, &
     !                         ncommon, nparts, tpwgts, options, objval, &
     !                         epart, npart)                        
     ! epart = epart - 1 
 
     !!!--------------------------------------------------------------------!!!
  
 
      ! if(w_yn .eq. 0) then
         if(len_trim(mpi_file) .ne. 70) then                                                                                  
            u_name = mpi_file(1:len_trim(mpi_file)) // '/elemdomain.mpi'
         else 
            u_name = 'elemdomain.mpi'     
         endif      
   
         u_mpi = 400                                 
         open(u_mpi,file=u_name)        
         write(u_mpi,*) nelem
         do i = 1, nelem
               write(u_mpi,*) i, epart(i)
         enddo
         close(u_mpi)
 
!       else
!
!         if(len_trim(mpi_file) .ne. 70) then                                                                                  
!            u_name = mpi_file(1:len_trim(mpi_file)) // '/final.part'
!         else 
!            u_name = 'final.part'     
!         endif
!         
!         u_mpi = 400                                 
!         open(u_mpi,file=u_name)        
!         write(u_mpi,*) nelem
!         do i = 1, nelem
!               write(u_mpi,*) i, epart(i)
!         enddo
!         close(u_mpi)
 
      !  endif       
      
      return
      
      end subroutine mesh_partitioning