C Rutina 070
C-----------------------------------------------------------RESUELVE1---
c
c
SUBROUTINE RESUELVE4(Aij,Fi,Xj,N)
C
C The subroutine pivo solves the system of equations applying a
C standard elimination Gauss Method with pivoting for columns.
C
C Aij*Xj=Fi
C
IMPLICIT NONE
INCLUDE '_param.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C A(,),F(),X() : Matriz del sistema,termino independiente e incognitas
REAL*8 Aij(N_MAX_INC,N_MAX_INC),Fi(N_MAX_INC),Xj(N_MAX_INC)
C N : Numero de filas
INTEGER N
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C F,C,FF : Contadores
INTEGER ff,f,cc,c,p
C PMX: Posicion de pivote maximo
INTEGER Fp,Cp
C MX : Pivote maximo
REAL*8 MX,ELE
C IPIVO(): Pivotes
INTEGER FPIVO(N_MAX_INC)
INTEGER CPIVO(N_MAX_INC)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Bucle que recorre las ecuaciones
C
DO p = 1 , n
FPIVO(p)=p
CPIVO(p)=p
END DO
C
WRITE(*,*)
WRITE(*,*)
C
DO p = 1 , n
C
Fp=p
Cp=p
C
mx=DABS(Aij(FPIVO(Fp),CPIVO(Cp)))
C
C Calculo del pivote maximo
C
DO ff = p , n
C
f=FPIVO(ff)
C
DO cc = p , n
C
c=CPIVO(cc)
ele=DABS(Aij(f,c))
C
IF(ele.GT.mx) THEN
Fp=ff
Cp=cc
mx=ele
END IF
C
END DO
C
END DO
C
ff=FPIVO(p)
FPIVO(p )=FPIVO(Fp)
FPIVO(Fp)=ff
C
cc=CPIVO(p)
CPIVO(p )=CPIVO(Cp)
CPIVO(Cp)=cc
C
Fp=FPIVO(p)
Cp=CPIVO(p)
C
IF(mx.NE.DABS(Aij(Fp,Cp)))THEN
WRITE(*,*) 'Error: ',n,Aij(Fp,Cp),mx
END IF
C
IF(DABS(mx).LT.TOL) THEN
C Matriz singular
WRITE(F_W,13201) mx , n-p+1 , Fi(Fp)
WRITE (*,13201) mx , n-p+1 , Fi(Fp)
oops STOP
ELSE
C
WRITE(*,1) p,n,mx
C
DO cc = p+1 , n
c=CPIVO(cc)
Aij(Fp,c)=Aij(Fp,c)/Aij(Fp,Cp)
END DO
Fi(Fp)=Fi(Fp)/Aij(Fp,Cp)
Aij(Fp,Cp)=1.d0
C
DO f = 1 , n
IF(f.ne.Fp) THEN
DO cc = p+1 , n
c=CPIVO(cc)
Aij(f,c)=Aij(f,c) - Aij(f,Cp) * Aij(Fp,c)
END DO
Fi(f)=Fi(f)-Aij(f,Cp)*Fi(Fp)
Aij(f,Cp)=0.d0
END IF
END DO
C
END IF
C
END DO
C
DO p = 1 , n
c=CPIVO(p)
f=FPIVO(p)
Xj(c)=Fi(f)
END DO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
13201 FORMAT(/,2x,'ERROR 13201 - RESUELVE1 - Matriz singular (',e8.2,
@ ',',i4,')-','(F=',e8.2,').')
1 FORMAT('+',2x,'RESUELVE1-Pivotando: ',i6,' - ',i6,' - ',e8.2)
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
