DOUG 0.2

SpMtx_permutation.f90

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 !--------------------------------
00023 ! Permutations:
00024 !   Build permutation
00025 !   Return old to new permutation
00026 !   Return new to old permutation
00027 !--------------------------------
00028 module SpMtx_permutation
00029 
00030   use SpMtx_class
00031   use Mesh_class
00032   use RealKind
00033 
00034   implicit None
00035 
00036 contains
00037 
00038 
00039   !----------------------------------
00040   ! Build permutation map
00041   !----------------------------------
00042   subroutine SpMtx_buildPermMap(A, M)
00043     implicit none
00044     
00045     type(SpMtx), intent(in out) :: A ! System matrix
00046     type(Mesh),      intent(in) :: M ! Mesh
00047 
00048     integer :: iin, iintf, lf, nfintf
00049 
00050     allocate(A%perm_map(M%nlf))
00051 
00052     write(stream,'(/a)',advance='no') 'Building freedoms permutation map ... '
00053 
00054     nfintf = sum(M%inner_interf_fmask) ! number of interface freedoms
00055     iin = nfintf
00056     iintf = 0
00057     do lf = 1,M%nlf
00058        if (M%inner_interf_fmask(lf) == D_FREEDOM_INNER) then
00059           iin = iin + 1
00060           A%perm_map(iin) = lf
00061        else
00062           iintf = iintf + 1 
00063           A%perm_map(iintf) = lf
00064        end if
00065        if (iintf > nfintf) &
00066             call DOUG_abort('[SpMtx_buildFPermutMap] : SEVERE : iintf '//&
00067             '> nfintf', -1)
00068     end do
00069 
00070     write(stream,*) 'done'
00071   end subroutine SpMtx_buildPermMap
00072  
00073 
00074   !------------------------------------
00075   ! Fill in permutation map
00076   !------------------------------------
00077   subroutine SpMtx_fillPermMap(A, perm)
00078     implicit none
00079     
00080     type(SpMtx),           intent(in out) :: A 
00081     integer, dimension(:), intent(in)     :: perm
00082 
00083     write(stream,'(/a)',advance='no') 'Filling in freedoms permutaiton map ...'
00084 
00085     allocate(A%perm_map(size(perm)))
00086     A%perm_map = perm
00087 
00088     write(stream,*) ' done.'
00089   end subroutine SpMtx_fillPermMap
00090 
00091 
00092   !----------------------------------------
00093   ! Returns old to new permutation
00094   !----------------------------------------
00095   subroutine SpMtx_getOldToNewPerm(A, perm)
00096     implicit none
00097 
00098     type(SpMtx),               intent(in) :: A
00099     integer, dimension(:), intent(in out) :: perm
00100 
00101     if (size(perm) /= size(A%perm_map)) &
00102          call DOUG_abort('[SpMtx_getOldToNewPerm] : SEVERE : size(perm)'//&
00103          ' /= size(A%perm_map)',-1)
00104 
00105     perm = A%perm_map
00106   end subroutine SpMtx_getOldToNewPerm
00107 
00108 
00109   !----------------------------------------
00110   ! Returns new to old permutation
00111   !----------------------------------------
00112   subroutine SpMtx_getNewToOldPerm(A, perm)
00113     implicit none
00114 
00115     type(SpMtx),               intent(in) :: A
00116     integer, dimension(:), intent(in out) :: perm
00117 
00118     integer                               :: n, i, j
00119 
00120     n = size(perm)
00121     if (n /= size(A%perm_map)) &
00122          call DOUG_abort('[SpMtx_getNewToOldPerm] : SEVERE : size(perm)'//&
00123          ' /= size(A%perm_map)',-1)
00124 
00125     perm = -1
00126     do j = 1,n
00127        i = A%perm_map(j)
00128        if ((i > 0).and.(i <= n)) perm(i) = j
00129     end do
00130   end subroutine SpMtx_getNewToOldPerm
00131 
00132 end module SpMtx_permutation