Sources Esope | Cast3M

invalm
C INVALM    SOURCE    PV        21/12/14    21:15:06     11221          
      SUBROUTINE INVALM(D,LL,MM,KERRE,PREC)
C
C         INVERSION D UNE MATRICE MM,MM CONTENUE DS UNE MATRICE LL,LL
C          CETTE MATRICE EST DANS LE COIN SUPERIEUR GAUCHE
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION D(1)
**    write(6,*) 'invalm entree ',ll,mm
**    do i=1,mm
**        write(6,*) (d((i-1)*ll+j),j=1,mm)
**    enddo
      KERRE=0
      zprec=0.d0
      do  i=1,mm
      do  j=1,mm
       IJ=LL*(I-1)+J
       zprec=max(zprec,abs(d(ij)))
      enddo
      enddo
      zprec=zprec*prec
      DO 200 N=1,MM
      NN=LL*(N-1)+N
      DIAG=D(NN)
      IF(ABS(DIAG).LE.ZPREC) THEN
**    write(6,*) ' invalm erreur ',NN
      KERRE=49
      RETURN
      ENDIF
      DIAG=1./DIAG
      DO 100 J=1,MM
      NJ=LL*(N-1)+J
      D(NJ)=-D(NJ)*DIAG
 100  continue
      DO 150 I=1,MM
      IN=LL*(I-1)+N
      IF(I.EQ.N) GO TO 150
      DO 140 J=1,MM
      IF(J.EQ.N) GO TO 140
      NJ=LL*(N-1)+J
      IJ=LL*(I-1)+J
      D(IJ)=D(IJ)+D(IN)*D(NJ)
  140 CONTINUE
      D(IN)=D(IN)*DIAG
  150 continue
      D(NN)=DIAG
 200  continue
*     write(6,*) 'invalm sortie ',ll,mm
*     do i=1,mm
*         write(6,*) (d((i-1)*ll+j),j=1,mm)
*     enddo
      RETURN
      END