LCOV - code coverage report
Current view: top level - core - rinvgj.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 23 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : c............................................................rinvgj
       2           0 :       SUBROUTINE rinvgj(ainv,a,arraydim,n)
       3             : C   ********************************************************************
       4             : C   *                                                                  *
       5             : C   *                      AINV = A**(-1)                              *
       6             : C   *                                                                  *
       7             : C   *  invert A using the GAUSS-JORDAN - algorithm                     *
       8             : C   *  the 1- matrix is not set up and use is made of its structure    *
       9             : C   *                                                                  *
      10             : C   *                    REAL*8 VERSION                                *
      11             : C   *                                                                  *
      12             : C   ********************************************************************
      13             : 
      14             :       IMPLICIT NONE
      15             : c                                                        scan columns
      16             : C     .. Scalar Arguments ..
      17             :       INTEGER arraydim,n
      18             : C     ..
      19             : C     .. Array Arguments ..
      20             :       REAL a(arraydim,arraydim),ainv(arraydim,arraydim)
      21             : C     ..
      22             : C     .. Local Scalars ..
      23             :       REAL t,t1
      24             :       INTEGER icol,l,ll
      25             : C     ..
      26           0 :       DO 60 icol = 1,n
      27             : c                                               make A(ICOL,ICOL) = 1
      28           0 :          t1 = 1.0/a(icol,icol)
      29           0 :          DO 10 l = (icol+1),n
      30           0 :             a(icol,l) = a(icol,l)*t1
      31           0 :    10    CONTINUE
      32           0 :          DO 20 l = 1, (icol-1)
      33           0 :             ainv(icol,l) = ainv(icol,l)*t1
      34           0 :    20    CONTINUE
      35           0 :          ainv(icol,icol) = t1
      36             : c                                    make A(LL,ICOL) = 0 for LL<>ICOL
      37           0 :          DO 50 ll = 1,n
      38           0 :             IF (ll.NE.icol) THEN
      39           0 :                t = a(ll,icol)
      40           0 :                DO 30 l = (icol+1),n
      41           0 :                   a(ll,l) = a(ll,l) - a(icol,l)*t
      42           0 :    30          CONTINUE
      43           0 :                DO 40 l = 1, (icol-1)
      44           0 :                   ainv(ll,l) = ainv(ll,l) - ainv(icol,l)*t
      45           0 :    40          CONTINUE
      46           0 :                ainv(ll,icol) = -t1*t
      47             :             END IF
      48           0 :    50    CONTINUE
      49           0 :    60 CONTINUE
      50           0 :       RETURN
      51             :       END

Generated by: LCOV version 1.13