e4d_mat_inv.F90       coverage:  100.00 %func     95.31 %block


     1) module e4d_mat_inv_module
     2)   
     3)   public :: MIGS, ELGS
     4) 
     5) contains
     6) 
     7) ! Updated 10/24/2001.
     8) !
     9) !cccccccccccccccccccccccc     Program 4.4     cccccccccccccccccccccccccc
    10) !
    11) !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    12) !                                                                      c
    13) ! Please Note:                                                         c
    14) !                                                                      c
    15) ! (1) This computer program is part of the book, "An Introduction to   c
    16) !     Computational Physics," written by Tao Pang and published and    c
    17) !     copyrighted by Cambridge University Press in 1997.               c
    18) !                                                                      c
    19) ! (2) No warranties, express or implied, are made for this program.    c
    20) !                                                                      c
    21) !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    22) !
    23)       SUBROUTINE MIGS(A,N,X,INDX)
    24) !
    25) ! Subroutine to invert matrix A(N,N) with the inverse stored
    26) ! in X(N,N) in the output.
    27) 
    28) !
    29)       DIMENSION A(N,N),X(N,N),INDX(N),B(N,N)
    30) !
    31) 
    32)       DO I = 1, N
    33)         DO J = 1, N
    34)           B(I,J) = 0.0
    35)         ENDDO
    36)       ENDDO
    37)       DO I = 1, N
    38)         B(I,I) = 1.0
    39)       ENDDO
    40) !
    41)       CALL ELGS(A,N,INDX)
    42) !
    43)       DO I = 1, N-1
    44)         DO J = I+1, N
    45)           DO K = 1, N
    46)             B(INDX(J),K) = B(INDX(J),K) &
    47)                           -A(INDX(J),I)*B(INDX(I),K)
    48)           ENDDO
    49)         ENDDO
    50)       ENDDO
    51) !
    52)       DO I = 1, N
    53)         X(N,I) = B(INDX(N),I)/A(INDX(N),N)
    54)         DO J = N-1, 1, -1
    55)           X(J,I) = B(INDX(J),I)
    56)           DO K = J+1, N
    57)             X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
    58)           ENDDO
    59)           X(J,I) =  X(J,I)/A(INDX(J),J)
    60)         ENDDO
    61)       ENDDO
    62) !
    63)       RETURN
    64)       END SUBROUTINE
    65) !
    66)       SUBROUTINE ELGS(A,N,INDX)
    67) !
    68) ! Subroutine to perform the partial-pivoting Gaussian elimination.
    69) ! A(N,N) is the original matrix in the input and transformed
    70) ! matrix plus the pivoting element ratios below the diagonal in
    71) ! the output.  INDX(N) records the pivoting order.
    72) 
    73) !
    74)       DIMENSION A(N,N),INDX(N),C(N)
    75) !
    76) ! Initialize the index
    77) !
    78)       DO I = 1, N
    79)         INDX(I) = I
    80)       ENDDO
    81) !
    82) ! Find the rescaling factors, one from each row
    83) !
    84)         DO I = 1, N
    85)           C1= 0.0
    86)           DO J = 1, N
    87)             C1 = AMAX1(C1,ABS(A(I,J)))
    88)           ENDDO
    89)           C(I) = C1
    90)         ENDDO
    91) !
    92) ! Search the pivoting (largest) element from each column
    93) !
    94)       DO J = 1, N-1
    95)         PI1 = 0.0
    96)         DO I = J, N
    97)           PI = ABS(A(INDX(I),J))/C(INDX(I))
    98)           IF (PI.GT.PI1) THEN
    99)             PI1 = PI
   100)             K   = I
   101)           ELSE
   102)           ENDIF
   103)         ENDDO
   104) !
   105) ! Interchange the rows via INDX(N) to record pivoting order
   106) !
   107)         ITMP    = INDX(J)
   108)         INDX(J) = INDX(K)
   109)         INDX(K) = ITMP
   110)         DO I = J+1, N
   111)           PJ  = A(INDX(I),J)/A(INDX(J),J)
   112) !
   113) ! Record pivoting ratios below the diagonal
   114) !
   115)           A(INDX(I),J) = PJ
   116) !
   117) ! Modify other elements accordingly
   118) !
   119)           DO K = J+1, N
   120)             A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
   121)           ENDDO
   122)         ENDDO
   123)       ENDDO
   124) !
   125)       RETURN
   126)       END SUBROUTINE
   127) 
   128) end module e4d_mat_inv_module

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody