1 : C NTAP12 SOURCE CHAT 05/01/13 02:01:57 5004 2 : SUBROUTINE NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : -INC TMXMAT 6 : -INC SMLENTI 7 : -INC CCOPTIO 8 : -INC SMLREEL 9 : POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE6.MLREEL 10 : MXMAT=MCP 11 : MXMA1=MCQ 12 : MXMA2=MVDU 13 : MXMA3=MVDL 14 : JG=M 15 : SEGINI MLREEL 16 : DO 1 J=1,M 17 : IF (XMAT(J,II).EQ.0.D0) THEN 18 : PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1) 19 : ELSE 20 : PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1) 21 : ENDIF 22 : 1 CONTINUE 23 : * CONSTRUCTION DE LA MATRICE IDENTITE 24 : LDIM1=M 25 : LDIM2=M 26 : SEGINI MXMAT,MXMA2 27 : DO 2 I=1,M 28 : XMAT(I,I)=1 29 : 2 CONTINUE 30 : XNORM2=0.D0 31 : DO 3 I=1,M 32 : XNORM2=PROG(I)**2+XNORM2 33 : 3 CONTINUE 33 : CALL XITY(PROG,PROG,M,MXMA2.XMAT) 34 : XNORM2=1./XNORM2 34 : CALL REEMAT(XNORM2,MXMA2.XMAT,M,M) 34 : CALL ADDIMA(XMAT,MXMA2.XMAT,M,M,2) 35 : MP=MXMAT 36 : IF(IIMPI.EQ.1799)THEN 37 : MXMAT=MP 38 : WRITE(IOIMP,'('' MATRICE DE PROJECTION'')') 39 : DO 200 I=1,M 40 : WRITE(IOIMP,'('' LIGNE '',I2)')I 41 : DO 200 J=1,M 42 : WRITE(IOIMP,'(1X,E12.5)')XMAT(I,J) 43 : 200 CONTINUE 44 : ENDIF 45 : RETURN 46 : END 47 :
© Cast3M 2003 - All rights reserved.
Disclaimer