1 : C NTAPE1 SOURCE CHAT 05/01/13 02:02:13 5004 2 : SUBROUTINE NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU, 3 : $ MVDL,IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL, 4 : $ IVXU,IVXL) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : -INC CCOPTIO 8 : -INC TMXMAT 9 : -INC SMLENTI 10 : -INC SMLREEL 11 : POINTEUR MLREE4.MLREEL,MLREE5.MLREEL 12 : POINTEUR MLREE6.MLREEL,MLREE7.MLREEL 13 : MXMAT=MCP 14 : N11= N + 1 15 : MLREEL=IVLAMB 16 : JG =XMAT(/2) 17 : SEGINI MLREE1,MLREE2 17 : CALL MATVE1(XMAT,PROG,M,N11,MLREE1.PROG,1) 18 : MXMAT=MCQ 18 : CALL MATVE1(XMAT,PROG,M,N11,MLREE2.PROG,1) 19 : MLREEL=IVFP 19 : CALL AEQAPB(MLREE1.PROG,PROG,N11) 20 : MLREEL=IVFQ 20 : CALL AEQAPB(MLREE2.PROG,PROG,N11) 21 : * 22 : * EVALUATION DES VARIABLES DISCRETES 23 : * 24 : JG=N11 25 : SEGINI MLREEL,MLREE3 26 : IF(NVD.NE.0) THEN 27 : MXMAT=MVDU 28 : MXMA1=MVDL 29 : NDIS=XMAT(/2)-2 30 : JG=NVD 31 : SEGINI MLREE4 32 : DO 2 I=1,NVD 33 : CT=MLREE1.PROG(I) 34 : IF (MLREE1.PROG(I).LT.1.D-15) CT=1.D-15 35 : MLREE4.PROG(I)=MLREE2.PROG(I)/CT 36 : 2 CONTINUE 37 : DO 1 I=1,NVD 38 : PROG(I)=XMAT(I,2) 39 : MLREE3.PROG(I)=MXMA1.XMAT(I,2) 40 : DO 4 K=3,NDIS 41 : XXK=XMAT(I,K-1)*XMAT(I,K) 42 : XXK=MXMA1.XMAT(I,K-1)*MXMA1.XMAT(I,K)/XXK 43 : XXK1=XMAT(I,K)*XMAT(I,K+1) 44 : XXK1=MXMA1.XMAT(I,K)*MXMA1.XMAT(I,K+1)/XXK1 45 : IF(XXK.LE.MLREE4.PROG(I).AND.XXK1.GT.MLREE4.PROG(I)) THEN 46 : PROG(I)=XMAT(I,K) 47 : MLREE3.PROG(I)=MXMA1.XMAT(I,K) 48 : GO TO 1 49 : ENDIF 50 : XXF=XMAT(I,NDIS+1)*XMAT(I,NDIS) 51 : XXF=MXMA1.XMAT(I,NDIS+1)*MXMA1.XMAT(I,NDIS)/XXF 52 : IF(XXF.LE.MLREE4.PROG(I)) THEN 53 : PROG(I)=XMAT(I,NDIS+1) 54 : MLREE3.PROG(I)=MXMA1.XMAT(I,NDIS+1) 55 : ENDIF 56 : 4 CONTINUE 57 : 1 CONTINUE 58 : SEGSUP MLREE4 59 : ENDIF 60 : * 61 : * EVALUATIONS DES VARIABLES CONTINUES 62 : * 63 : NK=N11-NVD 64 : JG=N11 65 : SEGINI MLENTI 66 : DO 3 I=1,NK 67 : J=I+NVD 68 : * DERIVEE EN XMIN 69 : MLREE4=IVMINU 70 : MLREE5=IVMINL 71 : T1=MLREE1.PROG(J)/(MLREE4.PROG(J)**2) 72 : T1=T1-(MLREE2.PROG(J)/(MLREE5.PROG(J)**2)) 73 : * DERIVEE EN XMAX 74 : MLREE6=IVMAXU 75 : MLREE7=IVMAXL 76 : T2=MLREE1.PROG(J)/(MLREE6.PROG(J)**2) 77 : T2=T2-(MLREE2.PROG(J)/(MLREE7.PROG(J)**2)) 78 : * CHOIX DE X(LAMBDA) 79 : IF(T1.GE.0.D0) THEN 80 : PROG(J)=MLREE4.PROG(J) 81 : MLREE3.PROG(J)=MLREE5.PROG(J) 82 : ENDIF 83 : IF(T2.LE.0.D0) THEN 84 : PROG(J)=MLREE6.PROG(J) 85 : MLREE3.PROG(J)=MLREE7.PROG(J) 86 : ENDIF 87 : MLREE4=IVUL 88 : MLREE5=IVLL 89 : IF(T1.LT.0.D0.AND.T2.GT.0.D0) THEN 90 : CTE=SQRT(MLREE1.PROG(J))*MLREE5.PROG(J) 91 : CTE=CTE+(SQRT(MLREE2.PROG(J))*MLREE4.PROG(J)) 92 : CTE=CTE/(SQRT(MLREE1.PROG(J))+SQRT(MLREE2.PROG(J))) 93 : PROG(J)=MLREE4.PROG(J)-CTE 94 : MLREE3.PROG(J)=CTE-MLREE5.PROG(J) 95 : LECT(J)=1 96 : ENDIF 97 : 3 CONTINUE 98 : IF(IVXU.NE.0) THEN 99 : MLREE7=IVXU 100 : SEGSUP MLREE7 101 : ENDIF 102 : IF(IVXL.NE.0) THEN 103 : MLREE7=IVXL 104 : SEGSUP MLREE7 105 : ENDIF 106 : IF(IVU.NE.0) THEN 107 : MLENT1=IVU 108 : SEGSUP MLENT1 109 : ENDIF 110 : IF(IVN.NE.0) THEN 111 : MLREE7=IVN 112 : SEGSUP MLREE7 113 : ENDIF 114 : IF(IVD.NE.0) THEN 115 : MLREE7=IVD 116 : SEGSUP MLREE7 117 : ENDIF 118 : IVXU=MLREEL 119 : IVXL=MLREE3 120 : IVU=MLENTI 121 : IVN=MLREE1 122 : IVD=MLREE2 123 : RETURN 124 : END 125 :
© Cast3M 2003 - All rights reserved.
Disclaimer