1 : C NTAP13 SOURCE CHAT 05/01/13 02:02:00 5004 2 : SUBROUTINE NTAP13 (MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : * 6 : * MISE A JOUR DE LA MATRICE DE PROJECTION 7 : * 8 : -INC TMXMAT 9 : -INC SMLREEL 10 : -INC CCOPTIO 11 : MXMAT=MCP 12 : MXMA1=MCQ 13 : MXMA2=MVDU 14 : MXMA3=MVDL 15 : JG=M 16 : SEGINI MLREEL 17 : DO 1 J=1,M 18 : IF(XMAT(J,II).EQ.0.D0) THEN 19 : PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1) 20 : ELSE 21 : PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1) 22 : ENDIF 23 : 1 CONTINUE 24 : SEGINI MLREE1 25 : MXMAT=MP 25 : CALL MATVE1( XMAT,PROG,M,M,MLREE1.PROG,2) 26 : LDIM1=M 27 : LDIM2=M 28 : SEGINI MXMAT 29 : XX=0.D0 30 : DO 2 I=1,M 31 : XX = MLREE1.PROG(I)*MLREE1.PROG(I) + XX 32 : 2 CONTINUE 32 : CALL XITY(MLREE1.PROG,MLREE1.PROG,M,XMAT) 33 : XX=1./XX 33 : CALL REEMAT(XX,XMAT,M,M) 34 : MXMA1=MP 34 : CALL ADDIMA(MXMA1.XMAT,XMAT,M,M,2) 35 : MP=MXMA1 36 : SEGSUP MLREEL,MLREE1 37 : RETURN 38 : END 39 :
© Cast3M 2003 - All rights reserved.
Disclaimer