DOUG 0.2

SpMtx_generator.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 !Random Sparse Matrix SpMtx_generator
00024 ! Allow generate symmetric and non-symmetric
00025 !  matrix
00026 !Informations:
00027 !   Diagonal elements are positive and nonzero
00028 !   Other elements are negaive
00029 !   Rowsum are positive
00030 !   NonZero elements are close to the diagonal
00031 !--------------------------------------
00032 Module SpMtx_generator
00033   Use RealKind
00034   Use SpMtx_class
00035   Use SpMtx_operation
00036   Implicit None
00037   !How close elements are to the diagonal
00038   ! not close 0..1 very close
00039   real(kind=rk), parameter:: const=0.8
00040   private:: const
00041 CONTAINS
00042 !-------------------------------------------
00043 !Generate Random Sparse Matrix
00044 ! Arguments:
00045 !           n : Matrix dim= N x N
00046 !               Number of Grid points
00047 !         max : max=|min element in matrix|
00048 !        prnt : if present (any integer value),
00049 !               then print the Matrix
00050 !   symmetric : generate symmetric matrix
00051 !               default=.TRUE.
00052 ! Result:
00053 !         A : Sparse Matrix
00054 !-------------------------------------------
00055   Function SpMtx_genRND(n,max,prnt,symmetric) result (A)
00056     Implicit None
00057     integer, optional                         :: prnt      !print matrix (prnt=1)
00058     logical, intent(in), optional             :: symmetric !symmetric matrix?
00059     logical                                   :: sym       !default=.TRUE.
00060     Type(SpMtx)                           :: A         !sparse matrix (generated)
00061     Integer, intent(in)                       :: n         !square matrix dimension
00062     Real(kind=rk), intent(in)                 :: max       !maximum element number (i/=j)
00063     real(kind=rk), dimension(:,:), allocatable:: M         !classical matrix
00064     integer                                   :: i, j, vahe
00065     real(kind=rk)                             :: koef, rnr, xmin,xmax
00066     !- - - - - - - - - - - - - - - - - - - - - - - - - - - -
00067     if (present(symmetric)) then
00068       sym=symmetric
00069                             else
00070       sym=.TRUE.
00071     end if
00072     allocate(M(1:n,1:n)); M=0.    !generate classical random matrix
00073     !----------------------------------------------------------
00074     do i=1,n
00075       do j=1,n
00076         vahe=abs(i-j)
00077         if (vahe /= 0) then
00078           koef=const**vahe
00079           xmin=0.0; xmax=1.0
00080           rnr=rnd(xmin,xmax)
00081           if (rnr < koef) then
00082             M(i,j)=Rnd(-max,xmin)
00083           end if
00084         end if
00085       end do
00086     end do
00087     do i=1,n
00088       koef=0.0
00089       do j=1,n
00090         koef=koef+abs(M(i,j))
00091       end do
00092       M(i,i)=Rnd(koef,2.0*koef)
00093     end do
00094     !----------------------------------------------
00095     !Make Symmetric matrix
00096     !----------------------------------------------
00097     if (sym) then
00098       do i=1,n
00099         do j=i+1,n
00100           M(i,j)=M(j,i)
00101         end do
00102       end do
00103     end if !symmetric
00104     !----------------------------------------------------------
00105     A = SpMtx_DenseToSparse(M)
00106     if (present(prnt)) call prindi(M)
00107     deallocate(M)
00108   End Function SpMtx_genRND
00109 !!$!---------------------------------------------------
00110 !!$!Generate Sparse Matrix structure
00111 !!$! M : regular Matrix (NxN)
00112 !!$! A : sparse matrix class
00113 !!$!---------------------------------------------------
00114 !!$  Function Make_SM(M) result(A)
00115 !!$    Implicit None
00116 !!$    Type(SpMtx)                          :: A  !sparse
00117 !!$    Real(kind=rk), intent(in), dimension(:,:):: M  !classic
00118 !!$    Integer                                  :: i, j, loend, n
00119 !!$    !- - - - - - - - - - - - - - - - - - - - - - - -
00120 !!$    loend=0
00121 !!$    do i=1,size(M,dim=1)
00122 !!$      do j=1,size(M, dim=2)
00123 !!$        if (M(i,j) /= 0.) loend=loend+1
00124 !!$      end do
00125 !!$    end do
00126 !!$    A=SpMtx_New(loend)
00127 !!$    A%nrows=size(M,dim=1)
00128 !!$    A%ncols=size(M,dim=2)
00129 !!$    n=0
00130 !!$    do i=1,A%nrows
00131 !!$      do j=1,A%ncols
00132 !!$        if (M(i,j) /= 0.) then
00133 !!$          n=n+1
00134 !!$          A%indi(n)=i
00135 !!$          A%indj(n)=j
00136 !!$          A%val(n)=M(i,j)
00137 !!$        end if
00138 !!$      end do
00139 !!$    end do
00140 !!$    if (n /= loend) print*, "ERROR: Dimensions conflict."
00141 !!$  End Function Make_SM
00142 !------------------------------------------------
00143 ! Random Number SpMtx_generator
00144 ! min : minimum element
00145 ! max : maximum element
00146 !------------------------------------------------
00147   Function Rnd(min,max) result(rand)
00148     Implicit None
00149     Real(kind=rk), intent(in):: min, max !max and min numbers
00150     real(kind=rk)            :: rand     !result random number
00151     !- - - - - - - - - - - - - - - - - - -
00152     call random_number(rand)
00153     rand=rand*(max-min)
00154     rand=rand+min
00155   End Function Rnd
00156 !------------------------------------------------
00157 !Print Matrix
00158 !  (not Sparse matrix structure)
00159 !------------------------------------------------
00160   Subroutine Prindi(M)
00161     Implicit None
00162     Real(kind=rk), intent(in), dimension(:,:):: M
00163     Integer, dimension(:,:), allocatable     :: MI
00164     integer                                  :: n, i
00165     n=size(M,dim=1)
00166     allocate(MI(1:n,1:n))
00167     MI=int(M)
00168     do i=1,n
00169       print*, MI(i,1:n)
00170     end do
00171   End Subroutine prindi
00172 End Module SpMtx_generator
00173 !----------------------------------------------------------------------
00174 !$Log: SpMtx_generator.f90,v $
00175 !Revision 1.3  2004/04/30 09:14:10  elmo
00176 !Formatting improved
00177 !
00178 !Revision 1.2  2004/03/17 09:37:33  smirme
00179 !Added initial version of interpolation operator.
00180 !Fixed some minor bugs.
00181 !
00182 !Revision 1.1  2004/03/08 07:37:15  elmo
00183 !Added files for AMG and some test files.
00184 !
00185 !----------------------------------------------------------------------