Sources Esope | Cast3M

etap14
C ETAP14    SOURCE    CHAT      05/01/12    23:46:11     5004
      SUBROUTINE ETAP14 (MP,II,M)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
*   MISE A JOUR DE LA MATRICE DE PROJECTION
*
 
-INC PPARAM
-INC CCOPTIO
-INC TMXMAT
-INC SMLREEL
      JG=M
      SEGINI MLREEL
      PROG(II)=1.D0
      SEGINI MLREE1
      MXMAT=MP
      CALL MATVE1( XMAT,PROG,M,M,MLREE1.PROG,2)
      LDIM1=M
      LDIM2=M
      SEGINI MXMAT
      XX=0.D0
      DO 2 I=1,M
      XX = MLREE1.PROG(I)*MLREE1.PROG(I) + XX
    2 CONTINUE
      CALL XITY(MLREE1.PROG,MLREE1.PROG,M,XMAT)
      XX=1./XX
      CALL REEMAT(XX,XMAT,M,M)
      MXMA1=MP
      CALL ADDIMA(MXMA1.XMAT,XMAT,M,M,2)
      DO 4 I=1,M
         MXMA1.XMAT(II,I)=0.D0
         MXMA1.XMAT(I,II)=0.D0
    4 CONTINUE
      MP=MXMA1
      SEGSUP MLREEL,MLREE1
      RETURN
      END