Il Linguaggio Fortran 90/95

6.6 Procedure intrinseche per gli array 359
in un equivalente sistema triangolare alto:
⎧
⎪⎨
⎪⎩
c1,1x1 + c1,2x2 + ... + c1,nxn = d1
c2,2x2 + ... + c2,nxn = d2
...
cn,nxn = dn
immediatamente invertibile per back-substitution. Affinché il criterio sia applicabile è necessario
che in ciascuna riga l’elemento di modulo massimo sia portato sulla diagonale principale
(pivoting).
MODULE solve_module
PUBLIC :: solve_linear_equations
CONTAINS
SUBROUTINE solve_linear_equations (a,x,b,error)
REAL,DIMENSION(:,:),INTENT (IN) :: A
REAL,DIMENSION(:),INTENT (OUT) :: x
REAL,DIMENSION(:),INTENT (IN) :: b
LOGICAL,INTENT(OUT) :: error
REAL,DIMENSION(:,:),ALLOCATABLE :: m
REAL,DIMENSION(:),ALLOCATABLE :: temp_row
INTEGER,DIMENSION (1) :: max_loc
INTEGER :: n, k, k_swap
n = SIZE(b)
error = (SIZE(A,DIM=1)/=n).OR.(SIZE(A,dim=2)/=n)
IF (error) THEN
x = 0.0
ELSE
ALLOCATE(m(n,n+1))
ALLOCATE(temp_row(n+1))
m(1:n,1:n) = A
m(1:n,n+1) = b
! Fase di triangolarizzazione
triang_loop: DO k =1,n
! Spostamento dell’elemento di valore assoluto massimo
! sulla diagonale principale
max_loc = MAXLOC(ABS(m(k:n,k)))
k_swap = k-1+max_loc(1)
temp_row(k:n+1) = m(k,k:n+1)
m(k,k:n+1) = m(k_swap,k:n+1)
m(k_swap,k:n+1) = temp_row(k:n+1)
IF (m(k,k)==0) THEN
error = .TRUE.
EXIT triang_loop