gaussji Function

public function gaussji(c, d, n) result(a)

Arguments

Type IntentOptional Attributes Name
real, intent(in) :: c(n,n)
real, intent(in) :: d(n,n)
integer :: n

Return Value real, (n,n)


Called by

proc~~gaussji~~CalledByGraph proc~gaussji gaussji proc~eb EB proc~eb->proc~gaussji proc~initeb initEB proc~initeb->proc~gaussji program~dalesurban DALESURBAN program~dalesurban->proc~eb program~dalesurban->proc~initeb

Source Code

  function gaussji(c,d,n) result(a)
    !Linear equation solution by Gauss-Jordan elimination, used to find inverse of matrix c.
    !possibly slow for large "c" (LAPACK better?)
    !c needs to be square and have dimension n
    !c(1:n,1:n) is an input matrix stored in an array of physical dimensions n by n.
    !d(1:n,1:n) is an input matrix containing the n by n identity matrix.
    !On  output, a(1:n,1:n) (and b(1:n,1:n)) are the inverse of c
    !Parameter: NMAX is  the  largest  anticipated  value  of n.

    integer :: n
    real, intent(in) :: c(n,n) !WILL BE OVERWRITTEN!!
    real, intent(in) :: d(n, n)
    real :: a(n,n),b(n,n)
    integer, parameter :: NMAX = 50
    integer :: m, i, icol, irow, j, k, l, ll, indxc(NMAX), indxr(NMAX), ipiv(NMAX)
    !The integer arrays ipiv, indxr, and indxc are  used for bookkeeping  on the pivoting.
    REAL :: big, dum, pivinv
    a=c
    b=d
    m=n
    do j = 1, n
      ipiv(j) = 0
    end do
    do i = 1, n !This  is  the  main  loop  over  the  columns  to  be  reduced.
      big = 0.
      do j = 1, n !This  is  the  outer  loop  of  the  search  for  a  pivot  element.
        if (ipiv(j) .ne. 1) then
          do k = 1, n
            if (ipiv(k) .eq. 0) then
              if (abs(a(j, k)) .ge. big) then
                big = abs(a(j, k))
                irow = j
                icol = k
              endif
              !else if (ipiv(k).gt.1) then
              !pause 'singular matrix in gaussj'
            end if
          end do
        end if
      end do
      ipiv(icol) = ipiv(icol) + 1
      !We  now  have  the  pivot  element,  so  we  interchange  rows,  if  needed,  to  put  the  pivot
      !element  on  the  diagonal.  The  columns  are  not  physically  interchanged,  only  relabeled:
      !indxc(i), the column of the ith pivot element, is the ith column that is reduced, while
      !indxr(i) is  the  row in  which  that  pivot  element  was  originally  located.  If
      !indxr(i) /= indxc(i) there  is  an  implied  column  interchange.  With  this  form  of  bookkeeping,  the
      !solution b's  will  end  up  in  the  correct  order,  and  the  inverse  matrix  will  be  scrambled by  columns
      if (irow .ne. icol) then
        do l = 1, n
          dum = a(irow, l)
          a(irow, l) = a(icol, l)
          a(icol, l) = dum
        end do
        do l = 1, m
          dum = b(irow, l)
          b(irow, l) = b(icol, l)
          b(icol, l) = dum
        enddo
      endif
      !We are now ready to divide the pivot row by the pivot element, located at irow and icol.
      indxr(i) = irow
      indxc(i) = icol
      !if (a(icol,icol).eq.0.) pause 'singular matrix in gaussj'
      pivinv = 1./a(icol, icol)
      a(icol, icol) = 1.
      do l = 1, n
        a(icol, l) = a(icol, l)*pivinv
      end do
      do l = 1, m
        b(icol, l) = b(icol, l)*pivinv
      end do
      do ll = 1, n
        !Next,  we  reduce  the  rows, except for the  pivot  one, of course.
        if (ll .ne. icol) then
          dum = a(ll, icol)
          a(ll, icol) = 0.
          do l = 1, n
            a(ll, l) = a(ll, l) - a(icol, l)*dum
          end do
          do l = 1, m
            b(ll, l) = b(ll, l) - b(icol, l)*dum
          end do
        end if
      end do
    end do
    !This is the end of the main loop over columns of the reduction.
    do l = n, 1, -1
      !It  only  remains  to  unscramble  the  solution  in  view
      !of  the  column  interchanges.  We  do  this  by  in-
      !terchanging pairs of columns in the reverse order
      !that the permutation was built  up.
      if (indxr(l) .ne. indxc(l)) then
        do k = 1, n
          dum = a(k, indxr(l))
          a(k, indxr(l)) = a(k, indxc(l))
          a(k, indxc(l)) = dum
        end do
      end if
    end do
    return
    !And  we  are  done.
  end function gaussji