DOUG 0.2

DenseMtx.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 ! Useful subroutines to work with dense matrices
00024 !-----------------------------------------------
00025 module DenseMtx_mod
00026 
00027   use DOUG_utils
00028   use RealKind
00029   use Mesh_class
00030   use IdxMap_class
00031 
00032   implicit none
00033 
00034 #include<doug_config.h>
00035 
00036 #ifdef D_COMPLEX
00037 #define float complex
00038 #else
00039 #define float real
00040 #endif
00041 
00042   interface DenseMtx_print
00043      module procedure DenseIMtx_print, DenseI1Mtx_print, DenseDMtx_print
00044   end interface
00045 
00046   private :: &
00047        DenseIMtx_print,  &
00048        DenseI1Mtx_print, &
00049        DenseDMtx_print
00050 
00051 contains
00052 
00053 
00054   !-------------------------------
00055   ! Matrix-vector multiplication
00056   !-------------------------------
00057   subroutine DenseMtx_mvm(D, x, y)
00058     implicit none
00059     
00060     float(kind=rk), dimension(:,:), intent(in out) :: D ! dense matrix
00061     float(kind=rk),   dimension(:), intent(in out) :: x, y
00062 
00063     integer :: i, j
00064 
00065     real(kind=rk) :: t1, t2
00066 
00067     if (size(D,1) /= size(y)) &
00068          call DOUG_abort('[DenseMtx_mvm] : size(D,1) /= size(y)',-1)
00069     if (size(D,2) /= size(x)) &
00070          call DOUG_abort('[DenseMtx_mvm] : size(D,2) /= size(x)',-1)
00071 
00072     !y = matmul(D,x)
00073 
00074     t1 = MPI_WTIME()
00075     do i = 1,size(D,1)
00076        do j = 1,size(D,2)
00077          ! if (D(i,j) /= 0.0_rk) &
00078                y(i) = y(i) + D(i,j)*x(j)
00079        end do
00080     end do
00081     t2 = MPI_WTIME()
00082     write(stream,*) 't2-t1=',t2-t1
00083   end subroutine DenseMtx_mvm
00084   !==============================
00085   !
00086   ! I/O
00087   !
00088   !------------------------------
00089   ! Prints out float dense matrix
00090   !------------------------------
00091   subroutine DenseDMtx_print(D, noSize)
00092     implicit none
00093 
00094     float(kind=rk), dimension(:,:), intent(in) :: D
00095     integer,              optional, intent(in) :: noSize
00096     integer :: i, j
00097 
00098     if (.not.present(noSize)) &
00099          write(stream,'(a,i5,a,i5,a)') ':size [',size(D,1),',',size(D,2),']:'
00100     
00101     do i = 1,size(D,1)
00102 !!$       write(stream,'(a,i5,a)', advance='no') '<',i,'>'
00103        do j = 1,size(D,2)
00104           write(stream, '(f7.4,a)', advance='no')  D(i,j)
00105           if (j /= size(D,2)) write(stream,'(a)',advance='no') ', '
00106        end do
00107        write(stream,*)
00108        call flush(stream)
00109     end do
00110   end subroutine DenseDMtx_print
00111 
00112 
00113   !--------------------------------
00114   ! Ptints out integer dense matrix
00115   !--------------------------------
00116   subroutine DenseIMtx_print(D, noSize)
00117     implicit none
00118 
00119     integer, dimension(:,:), intent(in) :: D
00120     integer,       optional, intent(in) :: noSize
00121     integer :: i, j
00122 
00123     if (.not.present(noSize)) &
00124          write(stream,'(a,i5,a,i5,a)') ':size [',size(D,1),',',size(D,2),']:'
00125 
00126     do i = 1,size(D,1)
00127 !!$       write(stream,'(a,i5,a)', advance='no') '<',i,'>'
00128        do j = 1,size(D,2)
00129           write(stream, '(i8,a)', advance='no')  D(i,j)
00130           if (j /= size(D,2)) write(stream,'(a)',advance='no') ', '
00131        end do
00132        write(stream,*)
00133        call flush(stream)
00134     end do
00135   end subroutine DenseIMtx_print
00136 
00137 
00138   !--------------------------------
00139   ! Ptints out integer dense matrix
00140   !--------------------------------
00141   subroutine DenseI1Mtx_print(D, noSize)
00142     implicit none
00143 
00144     integer(kind=1), dimension(:,:), intent(in) :: D
00145     integer,               optional, intent(in) :: noSize
00146     integer :: i, j
00147 
00148     if (.not.present(noSize)) &
00149          write(stream,'(a,i5,a,i5,a)') ':size [',size(D,1),',',size(D,2),']:'
00150 
00151     do i = 1,size(D,1)
00152 !!$       write(stream,'(a,i5,a)', advance='no') '<',i,'>'
00153        do j = 1,size(D,2)
00154           write(stream, '(i3,a)', advance='no')  D(i,j)
00155           if (j /= size(D,2)) write(stream,'(a)',advance='no') ', '
00156        end do
00157        write(stream,*)
00158        call flush(stream)
00159     end do
00160   end subroutine DenseI1Mtx_print
00161 
00162 end module DenseMtx_mod