DOUG 0.2

Aggregate_utils.f95

Go to the documentation of this file.
00001 ! DOUG - Domain decomposition On Unstructured Grids
00002 ! Copyright (C) 1998-2006 Faculty of Computer Science, University of Tartu and
00003 ! Department of Mathematics, University of Bath
00004 !
00005 ! This library is free software; you can redistribute it and/or
00006 ! modify it under the terms of the GNU Lesser General Public
00007 ! License as published by the Free Software Foundation; either
00008 ! version 2.1 of the License, or (at your option) any later version.
00009 !
00010 ! This library is distributed in the hope that it will be useful,
00011 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
00012 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00013 ! Lesser General Public License for more details.
00014 !
00015 ! You should have received a copy of the GNU Lesser General Public
00016 ! License along with this library; if not, write to the Free Software
00017 ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
00018 ! or contact the authors (University of Tartu, Faculty of Computer Science, Chair
00019 ! of Distributed Systems, Liivi 2, 50409 Tartu, Estonia, http://dougdevel.org,
00020 ! mailto:info(at)dougdevel.org)
00021 
00022 module Aggregate_utils_mod
00023   use Aggregate_mod
00024   use CoarseAllgathers
00025   use SpMtx_class
00026   use Mesh_class
00027   use SpMtx_util
00028 
00029   implicit none
00030 
00031 contains
00032 
00033   function getLocal(A,M) result(LA)
00034     type(SpMtx), intent(in) :: A
00035     type(Mesh), intent(in) :: M
00036     type(SpMtx) :: LA
00037     integer :: i
00038     integer,pointer :: indi(:), indj(:)
00039     real(kind=rk),pointer :: val(:)
00040 
00041     integer,allocatable :: nodes(:)
00042     
00043     allocate(nodes(count(M%eptnmap==myrank+1)))
00044     nodes = pack((/(i,i=1,size(M%eptnmap))/) , M%eptnmap==myrank+1)
00045     call GetGivenRowsElements(A,M%gl_fmap(nodes),indi,indj,val)
00046     LA = SpMtx_newInit(size(val),A%nblocks,maxval(indi),maxval(indj),indi=indi,indj=indj,val=val)
00047     deallocate(indi,indj,val)
00048     !write(stream,*) "---- LA"
00049     !call SpMtx_printRaw(LA)
00050 
00051   end function getLocal
00052 
00053  !> Write out aggregates to the specified file.
00054  !! If coarse aggregates are specified then it used to map fine aggregates to 
00055  !! coarse aggregates and write coarse aggregate numbers to file.
00056  subroutine Aggr_writeFile(aggr, filename, caggr)
00057    type(Aggrs), intent(in) :: aggr !< fine aggregates
00058    character(*) :: filename
00059    type(Aggrs), intent(in), optional :: caggr !< coarse aggregates
00060    integer :: i
00061 
00062    open(78, file=filename)
00063    if (.NOT.present(caggr)) then
00064       write (78,*) aggr%nagr, size(aggr%num)
00065       do i=1,size(aggr%num)
00066          write (78,*) aggr%num(i)
00067       end do
00068    else
00069       write (78,*) caggr%nagr, size(aggr%num)
00070       do i=1,size(aggr%num)
00071          write (78,*) caggr%num(aggr%num(i))
00072       end do
00073    end if
00074    close(78)
00075  end subroutine Aggr_writeFile
00076 
00077  !> Write all aggregates to file for testing with non-paralel case.
00078  subroutine Aggrs_writeFile(M, fAggr, cdata, filename)
00079    type(Mesh), intent(in) :: M
00080    type(AggrInfo), intent(in) :: fAggr
00081    type(CoarseData), intent(in) :: cdata
00082    character(*), intent(in) :: filename
00083 
00084    integer :: ierr, i, fd, k, l
00085    integer, allocatable :: sizes(:), disps(:), nodes(:), locs(:), allnodes(:)
00086    integer :: nnodes
00087 
00088    fd = 79
00089    if (ismaster()) then
00090      open(fd, file=filename)
00091      allocate(sizes(numprocs))
00092    end if
00093    
00094    call MPI_Gather(size(fAggr%inner%num), 1, MPI_INTEGER, sizes, 1, MPI_INTEGER, &
00095         0, MPI_COMM_WORLD, ierr)
00096 
00097    if (ismaster()) then
00098      nnodes = sum(sizes)
00099      write(fd,*) nnodes
00100      allocate(nodes(nnodes))
00101      allocate(locs(nnodes))
00102      allocate(disps(numprocs))
00103 
00104      ! scan
00105      disps(1) = 0
00106      do i=2,numprocs
00107        disps(i) = disps(i-1)+sizes(i-1)
00108      end do
00109    end if
00110 
00111    call MPI_Gatherv(M%lg_fmap, M%ninner, MPI_INTEGER, &
00112         locs, sizes, disps, MPI_INTEGER, &
00113         0, MPI_COMM_WORLD, ierr)
00114    call MPI_Gatherv(cdata%lg_cfmap(fAggr%inner%num), size(fAggr%inner%num), MPI_INTEGER, &
00115         nodes, sizes, disps, MPI_INTEGER, &
00116         0, MPI_COMM_WORLD, ierr)
00117 
00118    if (ismaster()) then
00119      allocate(allnodes(nnodes))
00120      do i=1,numprocs
00121        allnodes(locs) = nodes
00122      end do
00123      write(fd,*) allnodes     
00124    end if
00125 
00126   ! write coarse aggregate info
00127    call MPI_Gather(fAggr%inner%nagr, 1, MPI_INTEGER, sizes, 1, MPI_INTEGER, &
00128         0, MPI_COMM_WORLD, ierr)
00129 
00130    k = 0
00131    if (ismaster()) then
00132      write(fd,*) sum(sizes)
00133      ! assume that coarse aggregates are numbered by process
00134      do i=1,numprocs
00135        write(fd,*) (/(i, l=1,k+sizes(i))/)
00136        k = k+sizes(i)
00137      end do
00138 
00139      deallocate(sizes, disps, nodes)
00140    end if   
00141 
00142  end subroutine Aggrs_writeFile
00143 
00144  !> Read fine aggregates from file for testing with non-paralel case.
00145  subroutine Aggrs_readFile_fine(aggr, filename)
00146    type(AggrInfo), intent(inout) :: aggr
00147    character(*), intent(in) :: filename
00148 
00149    integer :: fd, nnodes, nagr
00150    integer, allocatable :: nodes(:)
00151 
00152    fd = 79
00153    open(fd, file=filename, status='OLD')
00154 
00155    read(fd,*) nnodes
00156    allocate(nodes(nnodes))
00157    read(fd,*) nodes
00158    nagr = maxval(nodes)
00159    call Form_Aggr(aggr%inner, nagr, nnodes, 2, 0, nodes)
00160    call Form_Aggr(aggr%full, nagr, nnodes, 2, 0, nodes)
00161    
00162  end subroutine Aggrs_readFile_fine
00163 
00164  !> Read coarse aggregates from file for testing with non-paralel case.
00165  subroutine Aggrs_readFile_coarse(aggr, filename)
00166    type(AggrInfo), intent(inout) :: aggr
00167    character(*), intent(in) :: filename
00168 
00169    integer :: fd, nnodes, nagr
00170    integer, allocatable :: nodes(:)
00171 
00172    fd = 79
00173 
00174    read(fd,*) nnodes
00175    allocate(nodes(nnodes))
00176    read(fd,*) nodes
00177    nagr = maxval(nodes)
00178    call Form_Aggr(aggr%inner, nagr, nnodes, 2, 0, nodes)
00179    call Form_Aggr(aggr%full, nagr, nnodes, 2, 0, nodes)
00180 
00181    close(fd)
00182  end subroutine Aggrs_readFile_coarse
00183 
00184 end module Aggregate_utils_mod