Sources Esope | Cast3M

ntap12
C NTAP12    SOURCE    CHAT      05/01/13    02:01:57     5004
      SUBROUTINE NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC TMXMAT
-INC SMLENTI
 
-INC PPARAM
-INC CCOPTIO
-INC SMLREEL
      POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE6.MLREEL
      MXMAT=MCP
      MXMA1=MCQ
      MXMA2=MVDU
      MXMA3=MVDL
      JG=M
      SEGINI MLREEL
      DO 1 J=1,M
         IF (XMAT(J,II).EQ.0.D0) THEN
        PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1)
         ELSE
        PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1)
          ENDIF
    1 CONTINUE
*  CONSTRUCTION DE LA MATRICE IDENTITE
      LDIM1=M
      LDIM2=M
      SEGINI MXMAT,MXMA2
      DO 2 I=1,M
           XMAT(I,I)=1
    2 CONTINUE
      XNORM2=0.D0
      DO 3 I=1,M
          XNORM2=PROG(I)**2+XNORM2
    3 CONTINUE
      CALL XITY(PROG,PROG,M,MXMA2.XMAT)
      XNORM2=1./XNORM2
      CALL REEMAT(XNORM2,MXMA2.XMAT,M,M)
      CALL ADDIMA(XMAT,MXMA2.XMAT,M,M,2)
      MP=MXMAT
      IF(IIMPI.EQ.1799)THEN
      MXMAT=MP
      WRITE(IOIMP,'('' MATRICE DE PROJECTION'')')
      DO 200 I=1,M
         WRITE(IOIMP,'('' LIGNE  '',I2)')I
         DO 200 J=1,M
            WRITE(IOIMP,'(1X,E12.5)')XMAT(I,J)
  200 CONTINUE
      ENDIF
      RETURN
      END