1 : C CHGLIM SOURCE CHAT 05/01/12 21:56:40 5004 2 : SUBROUTINE CHGLIM(IVX0,IVXMIN,IVXMAX,IVXPR1,IVXPR2,N,IP, 3 : * IVLL,IVUL,IVMIN,IVMAX,IMETH,IT0,IS0,XSMAX) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : -INC CCOPTIO 7 : -INC SMLREEL 8 : -INC SMTABLE 9 : -INC CCREEL 10 : POINTEUR MLREE4.MLREEL 11 : * 12 : * CALCUL DES VALEURS L(I,J) & U(I,J) 13 : * 14 : * en sortie ivmin et ivmax contiennent les nouvelles bornes de x 15 : * c'est a dire les anciens ivxmin et ivxmax 16 : * 17 : * methode normale avec t0 18 : * 19 : IF(IMETH.EQ.1) THEN 20 : MLREEL=IVX0 21 : MLREE1=IVLL 22 : MLREE2=IT0 23 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 24 : NN=PROG(/1) 25 : DO 1 K=1,NN-1 26 : MLREE1.PROG(K)=MLREE2.PROG(K)*PROG(K) 27 : 1 CONTINUE 28 : MLREE1.PROG(NN)=0.00 29 : IF(IIMPI.EQ.1799) WRITE(IOIMP,11)(MLREE1.PROG(K),K=1,N) 30 : 11 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5)) 31 : MLREE1=IVUL 32 : SEGACT MLREE1*MOD 33 : DO 2 K=1,NN-1 34 : MLREE1.PROG(K)=PROG(K)/MLREE2.PROG(K) 35 : 2 CONTINUE 36 : MLREE1.PROG(NN)=XSMAX+1. 37 : IF(IIMPI.EQ.1799) WRITE(IOIMP,12)(MLREE1.PROG(K),K=1,N) 38 : 12 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5)) 39 : * 40 : * methode MOVLIM sur s0 41 : * 42 : ELSEIF(IMETH.EQ.2) THEN 43 : IF(IP.LT.3) THEN 44 : MLREEL=IVX0 45 : MLREE1=IVXMAX 46 : MLREE2=IVXMIN 47 : MLREE3=IVLL 48 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD 49 : DO 20 K=1,N-1 50 : MLREE3.PROG(K)=PROG(K)* 0.7 51 : 20 CONTINUE 52 : MLREE3.PROG(N)=0.00 53 : IF(IIMPI.EQ.1799) WRITE(IOIMP,31)(MLREE3.PROG(K),K=1,N) 54 : 31 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5)) 55 : MLREE3=IVUL 56 : SEGACT MLREE3*MOD 57 : DO 22 K=1,N 58 : MLREE3.PROG(K)=MLREE1.PROG(K)-MLREE2.PROG(K) 59 : MLREE3.PROG(K)=PROG(K)+MLREE3.PROG(K) 60 : MLREE3.PROG(K)=PROG(K)/ 0.7 61 : 22 CONTINUE 62 : MLREE3.PROG(N)=XSMAX +1. 63 : IF(IIMPI.EQ.1799) WRITE(IOIMP,32)(MLREE3.PROG(K),K=1,N) 64 : 32 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5)) 65 : ELSE 66 : MLREEL=IVX0 67 : MLREE1=IVXPR1 68 : MLREE2=IVXPR2 69 : MLREE4=IS0 70 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE4*MOD 71 : JG=N 72 : SEGINI MLREE3 73 : DO 23 K=1,N-1 74 : OSCIL=(PROG(K)-MLREE1.PROG(K))*(MLREE1.PROG(K)-MLREE2.PROG(K)) 75 : IF(OSCIL.LT.0) THEN 76 : MLREE3.PROG(K)=MLREE4.PROG(K) 77 : ELSE 78 : MLREE3.PROG(K)=1./MLREE4.PROG(K) 79 : ENDIF 80 : 23 CONTINUE 81 : MLREE1=IVLL 82 : MLREE2=IVXPR1 83 : SEGACT MLREE1*MOD,MLREE2*MOD 84 : DO 24 K=1,N-1 85 : MLREE1.PROG(K)=PROG(K) - MLREE3.PROG(K)* 86 : * (MLREE2.PROG(K)-MLREE1.PROG(K)) 87 : 24 CONTINUE 88 : MLREE1.PROG(N)=0.00 89 : MLREE1=IVUL 90 : MLREE2=IVXPR1 91 : SEGACT MLREE1*MOD,MLREE2*MOD 92 : DO 25 K=1,N-1 93 : MLREE1.PROG(K)=PROG(K) + MLREE3.PROG(K)* 94 : * (MLREE1.PROG(K)-MLREE2.PROG(K)) 95 : 25 CONTINUE 96 : MLREE1.PROG(N)=XSMAX + 1. 97 : SEGSUP MLREE3 98 : ENDIF 99 : * 100 : * methode lineaire 101 : * 102 : ELSEIF(IMETH.EQ.3) THEN 103 : MLREEL=IVLL 104 : MLREE1=IVUL 105 : MLREE2=IVX0 106 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 107 : NN1 = MLREE2.PROG(/1)-1 108 : DO 41 K=1,NN1 109 : PROG(K)=0. 110 : MLREE1.PROG(K)=1000.*MLREE2.PROG(K) 111 : 41 CONTINUE 112 : PROG(N)=0.D0 113 : MLREE1.PROG(N)=XSMAX+1. 114 : IF(IIMPI.EQ.1799) WRITE(IOIMP,51)(PROG(K),K=1,N) 115 : 51 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5)) 116 : IF(IIMPI.EQ.1799) WRITE(IOIMP,52)(MLREE1.PROG(K),K=1,N) 117 : 52 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5)) 118 : ENDIF 119 : * 120 : * partie commune au trois methode : calcul de bornes inf et sup 121 : * 122 : MLREEL=IVX0 123 : MLREE1=IVLL 124 : MLREE3=IVXMIN 125 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE3*MOD 126 : JG=N 127 : SEGINI MLREE2 128 : IVMIN=MLREE2 129 : DO 3 K=1,N 130 : MLREE2.PROG(K)=MLREE3.PROG(K) 131 : CTE=0.95*MLREE1.PROG(K) + 0.05* PROG(K) 132 : IF( MLREE2.PROG(K).LE.CTE) MLREE2.PROG(K)=CTE 133 : 3 CONTINUE 134 : MLREE2.PROG(N)=1. 135 : MLREE1=IVUL 136 : MLREE3=IVXMAX 137 : SEGACT MLREE1*MOD,MLREE3*MOD 138 : JG=N 139 : SEGINI MLREE2 140 : IVMAX=MLREE2 141 : DO 4 K=1,N 142 : CTE=0.95*MLREE1.PROG(K) + 0.05 *PROG(K) 143 : MLREE2.PROG(K)=MLREE3.PROG(K) 144 : IF(MLREE2.PROG(K).GE.CTE) MLREE2.PROG(K)=CTE 145 : 4 CONTINUE 146 : MLREEL=IVMIN 147 : MLREE1=IVXMIN 148 : SEGACT MLREEL*MOD,MLREE1*MOD 149 : DO 6 K=1,N 150 : IF(MLREE1.PROG(K).GT.PROG(K))PROG(K)=MLREE1.PROG(K) 151 : 6 CONTINUE 152 : MLREEL=IVMAX 153 : MLREE1=IVXMAX 154 : SEGACT MLREEL*MOD,MLREE1*MOD 155 : DO 7 K=1,N 156 : IF(MLREE1.PROG(K).LT.PROG(K))PROG(K)=MLREE1.PROG(K) 157 : 7 CONTINUE 158 : RETURN 159 : END 160 : 161 : 162 : 163 :
© Cast3M 2003 - All rights reserved.
Disclaimer