| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=r64) | :: | A(NP,NP) | ||||
| integer | :: | n | ||||
| integer | :: | np | ||||
| integer | :: | INDX(N) | ||||
| integer | :: | D |
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.
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 LUDCMP(A,N,NP,INDX,D)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann?
! DATE WRITTEN <date_written>
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine performs a LU decompostion of given matrix.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
integer np,n
REAL(r64) :: A(NP,NP) ! matrix
integer INDX(N)
INTEGER D
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) VV(100),sum,aamax,dum
INTEGER I,J,K,imax
D=1
DO I=1,N
AAMAX=0.0d0
DO J=1,N
IF (ABS(A(I,J)) > AAMAX) AAMAX=ABS(A(I,J))
END DO
IF (AAMAX.EQ.0.0d0) THEN
CALL ShowFatalError('Singular matrix in LUDCMP, window calculations')
ENDIF
VV(I)=1.0d0/AAMAX ! Was commented out prior to 10/5/01, which caused overflows
! in this routine in rare cases
END DO
DO J=1,N
IF (J > 1) THEN
DO I=1,J-1
SUM=A(I,J)
IF (I > 1)THEN
DO K=1,I-1
SUM=SUM-A(I,K)*A(K,J)
ENDDO
A(I,J)=SUM
ENDIF
ENDDO
ENDIF
AAMAX=0.0d0
DO I=J,N
SUM=A(I,J)
IF (J > 1)THEN
DO K=1,J-1
SUM=SUM-A(I,K)*A(K,J)
ENDDO
A(I,J)=SUM
ENDIF
DUM=VV(I)*ABS(SUM)
IF (DUM.GE.AAMAX) THEN
IMAX=I
AAMAX=DUM
ENDIF
ENDDO
IF (J.NE.IMAX)THEN
DO K=1,N
DUM=A(IMAX,K)
A(IMAX,K)=A(J,K)
A(J,K)=DUM
ENDDO
D=-D
VV(IMAX)=VV(J)
ENDIF
INDX(J)=IMAX
IF(J.NE.N)THEN
IF(A(J,J).EQ.0.0d0) A(J,J)=rTinyValue
DUM=1.0d0/A(J,J)
DO I=J+1,N
A(I,J)=A(I,J)*DUM
ENDDO
ENDIF
ENDDO
IF(A(N,N).EQ.0.0d0) A(N,N)=rTinyValue
RETURN
END SUBROUTINE LUDCMP