Télécharger la plaquette Cast3M


fr en

Télécharger gajome.eso

Retour à la liste

Numérotation des lignes : 

gajome

  1. C GAJOME    SOURCE    CHAT      05/01/13    00:15:19     5004
  2.       SUBROUTINE GAJOME(A,M,N,B,IRET,IOIMP)
  3. *
  4. *     Cette subroutine associe a la matrice rectangulaire A de
  5. *     rang M et de dimension MxN ou M<N la matrice carree B de
  6. *     dimension NxN telle que A.B=[I:0] ou I est la matrice
  7. *     identite de dimension MxM et 0 la matrice nulle de
  8. *     dimension Mx(N-M).
  9. *
  10. *     P.PEGON (ISPRA) AOUT 1996
  11. *
  12. *************************************
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8 (A-H,O-Z)
  15.       DIMENSION A(M,N),B(N,N)
  16. *
  17.       IRET=0
  18.       IF (M.GT.N)THEN
  19.         WRITE(IOIMP,*)'GAJOME: reduction impossible'
  20.         IRET=1
  21.         RETURN
  22.       ENDIF
  23. *
  24. *     Initialisation de B a la matrice identite
  25. *
  26.       DO J=1,N
  27.         DO I=1,N
  28.           B(I,J)=0.D0
  29.         ENDDO
  30.         B(J,J)=1.D0
  31.       ENDDO
  32. *
  33. *     Boucle sur les lignes du systeme original
  34. *
  35.       DO I=1,M
  36. *
  37. *     recherche du pivot dnas la ligne I
  38. *
  39.         BIG=1.D-6
  40.         ICOL=0
  41.         DO J=I,N
  42.           IF (ABS(A(I,J)).GE.BIG)THEN
  43.             BIG=ABS(A(I,J))
  44.             ICOL=J
  45.           ENDIF
  46.         ENDDO
  47.         IF(ICOL.EQ.0)THEN
  48.           WRITE(IOIMP,*)'GAJOME: Il y a un mecanisme global'
  49.           IRET=1
  50.           RETURN
  51.         ENDIF
  52. *
  53. *     on place la colone pivot en position I et on fait de meme dans B
  54. *
  55.         IF (ICOL.NE.I)THEN
  56.           DO II=1,M
  57.             DUM=A(II,ICOL)
  58.             A(II,ICOL)=A(II,I)
  59.             A(II,I)=DUM
  60.           ENDDO
  61.           DO II=1,N
  62.             DUM=B(II,ICOL)
  63.             B(II,ICOL)=B(II,I)
  64.             B(II,I)=DUM
  65.           ENDDO
  66.         ENDIF
  67. *
  68. *     on pivote, on normalise la colonne et on reduit la ligne
  69. *
  70.         PIVINV=1.D0/A(I,I)
  71.         DO II=1,M
  72.           A(II,I)=A(II,I)*PIVINV
  73.         ENDDO
  74.         A(I,I)=1.D0
  75.         DO II=1,N
  76.           B(II,I)=B(II,I)*PIVINV
  77.         ENDDO
  78.         DO J=1,N
  79.           IF(J.NE.I)THEN
  80.             DUM=A(I,J)
  81.             IF(DUM.NE.0.D0)THEN
  82.               A(I,J)=0.D0
  83.               DO II=1,M
  84.                 A(II,J)=A(II,J)-A(II,I)*DUM
  85.               ENDDO
  86.               DO II=1,N
  87.                 B(II,J)=B(II,J)-B(II,I)*DUM
  88.               ENDDO
  89.             ENDIF
  90.           ENDIF
  91.         ENDDO
  92. *
  93.       ENDDO
  94. *
  95.       RETURN
  96.       END
  97.  
  98.  
  99.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales