1 : C NTAPE2 SOURCE CHAT 05/01/13 02:02:17 5004 2 : SUBROUTINE NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE, 3 : *IVGM,IVLAMB,IPBASE) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 ( A-H,O-Z) 6 : -INC TMXMAT 7 : -INC CCOPTIO 8 : -INC SMLREEL 9 : -INC SMLENTI 10 : POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE7.MLREEL 11 : N11=N + 1 12 : MXMAT=MCP 13 : MLREEL=IVXU 14 : MLREE1=IVXL 15 : SEGACT MLREEL,MLREE1 16 : JG=PROG(/1) 17 : SEGINI MLREE2,MLREE3 18 : DO 1 I=1,JG 19 : MLREE2.PROG(I)=1./PROG(I) 20 : MLREE3.PROG(I)=1./MLREE1.PROG(I) 21 : 1 CONTINUE 22 : JG=M 23 : SEGDES MLREEL,MLREE1 24 : SEGINI MLREEL,MLREE1,MLREE4,MLREE5 25 : IF(IVGM.NE.0) THEN 26 : MLREE7=IVGM 27 : SEGSUP MLREE7 28 : ENDIF 29 : IVGM=MLREE4 30 : IF(IVGE.NE.0) THEN 31 : MLREE7=IVGE 32 : SEGSUP MLREE7 33 : ENDIF 34 : IVGE=MLREE5 34 : CALL MATVE1(XMAT,MLREE2.PROG,M,N11,PROG,2) 35 : MXMAT=MCQ 35 : CALL MATVE1(XMAT,MLREE3.PROG,M,N11,MLREE1.PROG,2) 36 : SEGSUP MLREE2 37 : MLREE2=IVB 38 : DO 2 I=1,M 39 : MLREE5.PROG(I)=PROG(I) + MLREE1.PROG(I) - MLREE2.PROG(I) 40 : 2 CONTINUE 41 : SEGSUP MLREE1,MLREE3,MLREEL 42 : * 43 : * CALCUL DE LA DIRECTION DE MONTEE 44 : * 45 : MLENTI=IPBASE 46 : SEGACT MLENTI 47 : MLREEL=IVLAMB 48 : DO 3 I=1,M 49 : MLREE4.PROG(I)=MLREE5.PROG(I) 50 : IF(PROG(I).EQ.0. ) THEN 51 : IF(MLREE5.PROG(I).LT.0.D0) THEN 52 : MLREE4.PROG(I)=0.D0 53 : ENDIF 54 : ENDIF 55 : 3 CONTINUE 56 : DO 4 I=1,M 57 : IF (LECT(I) .EQ.1) MLREE4.PROG(I)=0.D0 58 : 4 CONTINUE 59 : RETURN 60 : END 61 :
© Cast3M 2003 - All rights reserved.
Disclaimer