Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | NORDER |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE MRXINV (NORDER)
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Oct. 2005
! MODIFIED na
! RE-ENGINEERED Revised based on Subroutine ADSINV
! PURPOSE OF THIS SUBROUTINE:
! This subroutine inverses a matrix
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: NORDER
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER I, J, K, M
REAL(r64) R1, S
! ############################################## MATRIX INVERSION
IVEC = 0
DO I=1,NORDER
IVEC(I+20) = I
END DO
DO I=1,NORDER
R1 = 0.0d0
M = I
DO J=I,NORDER
IF (ABS(R1) .LT. ABS(MA((I-1)*NORDER+J))) THEN
M = J
R1 = MA((I-1)*NORDER+J)
END IF
END DO
IF (I .NE. M) THEN
K = IVEC(M+20)
IVEC(M+20) = IVEC(I+20)
IVEC(I+20) = K
DO J=1,NORDER
S = MA((J-1)*NORDER+I)
MA((J-1)*NORDER+I) = MA((J-1)*NORDER+M)
MA((J-1)*NORDER+M) = S
END DO
END IF
MA((I-1)*NORDER+I) = 1.0d0
DO J=1,NORDER
MA((I-1)*NORDER+J) = MA((I-1)*NORDER+J)/R1
END DO
DO J=1,NORDER
IF (I .EQ. J) CYCLE
R1 = MA((J-1)*NORDER+I)
IF (ABS(R1) .LE. 1.0D-20) CYCLE
MA((J-1)*NORDER+I) = 0.0d0
DO K=1,NORDER
MA((J-1)*NORDER+K) = MA((J-1)*NORDER+K)-R1*MA((I-1)*NORDER+K)
END DO
60 END DO
END DO
DO I=1,NORDER
IF (IVEC(I+20) .EQ. I) CYCLE
M = I
DO WHILE (NORDER .GT. M)
70 M = M+1
IF (IVEC(M+20) .EQ. I) EXIT
END DO
80 IVEC(M+20) = IVEC(I+20)
DO J=1,NORDER
R1 = MA((I-1)*NORDER+J)
MA((I-1)*NORDER+J) = MA((M-1)*NORDER+J)
MA((M-1)*NORDER+J) = R1
END DO
IVEC(I+20) = I
90 END DO
RETURN
! ########################################################### END
END SUBROUTINE MRXINV