1 : C ETAPE4 SOURCE CHAT 05/01/12 23:46:18 5004 2 : SUBROUTINE ETAPE4(MCPLUS,MCMOIN,M,N,IVU,IVX,IVN,IMH) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : -INC TMXMAT 6 : -INC SMLREEL 7 : -INC CCOPTIO 8 : -INC SMLENTI 9 : POINTEUR MLREE4.MLREEL,MLREE5.MLREEL 10 : N11 = N + 1 11 : MLENTI=IVU 12 : MLREE1=IVN 13 : MLREE2=IVX 14 : ******* TEST SI VN = 0 ET SI VX = 0 15 : DO 100 I=1,N 16 : IF (MLREE1.PROG(I).LT.1.D-10) MLREE1.PROG(I)=1.D-10 17 : IF (MLREE2.PROG(I).LT.1.D-10) MLREE2.PROG(I)=1.D-10 18 : 100 CONTINUE 19 : JG=N11 20 : SEGINI MLREE3,MLREE4,MLREE5 21 : IVPN=MLREE3 22 : IVPP=MLREE4 23 : IVNN=MLREE5 24 : DO 1 I = 1,N11 25 : VNI2=MLREE1.PROG(I)*2 26 : VT=VNI2 * MLREE2.PROG(I) 27 : MLREE3.PROG(I)=LECT(I) /VT 28 : MLREE4.PROG(I)=LECT(I)*MLREE2.PROG(I)/VNI2 29 : MLREE5.PROG(I)=LECT(I)/VNI2/(MLREE2.PROG(I)**3) 30 : 1 CONTINUE 31 : LDIM1=N11 32 : LDIM2=M 33 : SEGINI MXMAT 34 : MXMA1=MCPLUS 35 : *1 35 : CALL MATMAD(MXMA1.XMAT,MLREE3.PROG,M,N11,XMAT) 36 : MXMA1=MCMOIN 37 : LDIM1=M 38 : LDIM2=M 39 : SEGINI MXMA2 40 : *2 40 : CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA2.XMAT) 41 : *3 41 : CALL MATMAD(MXMA1.XMAT,MLREE3.PROG,M,N11,XMAT) 42 : SEGINI MXMA4 43 : MXMA1=MCPLUS 44 : *4 44 : CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA4.XMAT) 45 : *4+ 45 : CALL ADDIMA(MXMA2.XMAT,MXMA4.XMAT,M,M,1) 46 : *5 46 : CALL MATMAD(MXMA1.XMAT,MLREE4.PROG,M,N11,XMAT) 47 : *6 47 : CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA4.XMAT) 48 : *6- 48 : CALL ADDIMA(MXMA2.XMAT,MXMA4.XMAT,M,M,2) 49 : *7 50 : MXMA1=MCMOIN 50 : CALL MATMAD(MXMA1.XMAT,MLREE5.PROG,M,N11,XMAT) 51 : *8 51 : CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA4.XMAT) 52 : *8- 52 : CALL ADDIMA(MXMA2.XMAT,MXMA4.XMAT,M,M,2) 53 : IMH=MXMA2 54 : SEGSUP MXMAT,MXMA4 55 : RETURN 56 : END 57 :
© Cast3M 2003 - All rights reserved.
Disclaimer