fortran subritinas gauss con pivoteo...

! Last change: AC 2 Jun 2010 10:06 pm
PROGRAM GAUSS
!========================================
!RESOLUCION DE MATRICES A TRAVES DE ¦¦
!METODO DE GAUSS Y PIVOTEO ¦¦
!========================================
IMPLICIT NONE
INTEGER:: I,J,K,N
REAL:: FACTOR
REAL,ALLOCATABLE :: MAT(:,:),RESULTADOS(:)
WRITE(*,*)"PROGRAMA DE RESOLUCION DE ECUACIONES"
WRITE(*,*)" A PARTIR DEL METODO DE GAUSS "
WRITE(*,*)""
WRITE(*,*)""
WRITE(*,*)"INTRODUCE EL NUMERO INCOGNITAS EN LAS ECUACIONES: "
READ(*,*)N
ALLOCATE (MAT(N,N+1),RESULTADOS(N))
DO I=1,N,1
DO J=1,N+1,1
WRITE(*,*)"INTRODUCE EL ELEMENTO (",I,",",J,"): "
READ(*,*)MAT(I,J)
END DO
END DO
DO K=1,N-1,1
DO I=K,N-1,1
IF (K==I) THEN
CALL PIVOTE(MAT,N,K)
ENDIF
FACTOR=MAT(I+1,K)/MAT(K,K)
DO J=1,N+1,1
MAT(I+1,J)=MAT(I+1,J)-(FACTOR*MAT(K,J))
ENDDO
ENDDO
ENDDO
WRITE(*,*)"LA MATRIZ RESULTANTE DESPUES DE LAS OPERACIONES ES LA SIGUIENTE:"
WRITE(*,*)""
DO I=1,N,1
DO J=1,N+1,1
WRITE(*,*)"(",I,",",J,")",MAT(I,J)
ENDDO
ENDDO
CALL SOLUCION(MAT,N,RESULTADOS)
WRITE(*,*)"LOS RESULTADOS PARA LOS VALORES DE X SON LOS SIGUIENTES: "
DO I=1,N,1
WRITE(*,*)" X(",I,"):",RESULTADOS(I)
ENDDO
ENDPROGRAM

SUBROUTINE PIVOTE(MAT,N,I)
!===================================================
!SUBRUTINA QUE NOS AYUDA A DETERMINAR EL ELEMENTO ¦¦
!MAYOR A SER CONSIDERADO EL PIVOTE DE LOS CALCULOS¦¦
!Y LO REEMPLAZA EN EL ORDEN DE LOS MISMOS ¦¦
!===================================================
IMPLICIT NONE
INTEGER::I,N,K,INDICE,BAND
REAL::TEMP
REAL,DIMENSION(N,N+1)::MAT
BAND=0
INDICE=I
DO K=I+1,N,1
IF (ABS(MAT(INDICE,I)) INDICE=K
BAND=1
ENDIF
ENDDO
IF (BAND/=0) THEN
DO K=I,N+1,1
TEMP=MAT(INDICE,K)
MAT(INDICE,K)=MAT(I,K)
MAT(I,K)=TEMP
ENDDO
ENDIF
RETURN
ENDSUBROUTINE
SUBROUTINE SOLUCION(MAT,N,RESULTADOS)
IMPLICIT NONE
INTEGER:: I,J,N
REAL:: SUMA
REAL,DIMENSION(N)::RESULTADOS
REAL,DIMENSION(N,N+1)::MAT
SUMA=0
RESULTADOS(N)=MAT(N,N+1)/MAT(N,N)
DO I=N-1,1,-1
DO J=I+1,N,1
SUMA=SUMA+(MAT(I,J)*RESULTADOS(J))
ENDDO
RESULTADOS(I)=(MAT(I,N+1)-SUMA)/MAT(I,I)
ENDDO
RETURN
ENDSUBROUTINE