C CHGLIM SOURCE CHAT 05/01/12 21:56:40 5004 SUBROUTINE CHGLIM(IVX0,IVXMIN,IVXMAX,IVXPR1,IVXPR2,N,IP, * IVLL,IVUL,IVMIN,IVMAX,IMETH,IT0,IS0,XSMAX) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO -INC SMLREEL -INC SMTABLE -INC CCREEL POINTEUR MLREE4.MLREEL * * CALCUL DES VALEURS L(I,J) & U(I,J) * * en sortie ivmin et ivmax contiennent les nouvelles bornes de x * c'est a dire les anciens ivxmin et ivxmax * * methode normale avec t0 * IF(IMETH.EQ.1) THEN MLREEL=IVX0 MLREE1=IVLL MLREE2=IT0 SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD NN=PROG(/1) DO 1 K=1,NN-1 MLREE1.PROG(K)=MLREE2.PROG(K)*PROG(K) 1 CONTINUE MLREE1.PROG(NN)=0.00 IF(IIMPI.EQ.1799) WRITE(IOIMP,11)(MLREE1.PROG(K),K=1,N) 11 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5)) MLREE1=IVUL SEGACT MLREE1*MOD DO 2 K=1,NN-1 MLREE1.PROG(K)=PROG(K)/MLREE2.PROG(K) 2 CONTINUE MLREE1.PROG(NN)=XSMAX+1. IF(IIMPI.EQ.1799) WRITE(IOIMP,12)(MLREE1.PROG(K),K=1,N) 12 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5)) * * methode MOVLIM sur s0 * ELSEIF(IMETH.EQ.2) THEN IF(IP.LT.3) THEN MLREEL=IVX0 MLREE1=IVXMAX MLREE2=IVXMIN MLREE3=IVLL SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD DO 20 K=1,N-1 MLREE3.PROG(K)=PROG(K)* 0.7 20 CONTINUE MLREE3.PROG(N)=0.00 IF(IIMPI.EQ.1799) WRITE(IOIMP,31)(MLREE3.PROG(K),K=1,N) 31 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5)) MLREE3=IVUL SEGACT MLREE3*MOD DO 22 K=1,N MLREE3.PROG(K)=MLREE1.PROG(K)-MLREE2.PROG(K) MLREE3.PROG(K)=PROG(K)+MLREE3.PROG(K) MLREE3.PROG(K)=PROG(K)/ 0.7 22 CONTINUE MLREE3.PROG(N)=XSMAX +1. IF(IIMPI.EQ.1799) WRITE(IOIMP,32)(MLREE3.PROG(K),K=1,N) 32 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5)) ELSE MLREEL=IVX0 MLREE1=IVXPR1 MLREE2=IVXPR2 MLREE4=IS0 SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE4*MOD JG=N SEGINI MLREE3 DO 23 K=1,N-1 OSCIL=(PROG(K)-MLREE1.PROG(K))*(MLREE1.PROG(K)-MLREE2.PROG(K)) IF(OSCIL.LT.0) THEN MLREE3.PROG(K)=MLREE4.PROG(K) ELSE MLREE3.PROG(K)=1./MLREE4.PROG(K) ENDIF 23 CONTINUE MLREE1=IVLL MLREE2=IVXPR1 SEGACT MLREE1*MOD,MLREE2*MOD DO 24 K=1,N-1 MLREE1.PROG(K)=PROG(K) - MLREE3.PROG(K)* * (MLREE2.PROG(K)-MLREE1.PROG(K)) 24 CONTINUE MLREE1.PROG(N)=0.00 MLREE1=IVUL MLREE2=IVXPR1 SEGACT MLREE1*MOD,MLREE2*MOD DO 25 K=1,N-1 MLREE1.PROG(K)=PROG(K) + MLREE3.PROG(K)* * (MLREE1.PROG(K)-MLREE2.PROG(K)) 25 CONTINUE MLREE1.PROG(N)=XSMAX + 1. SEGSUP MLREE3 ENDIF * * methode lineaire * ELSEIF(IMETH.EQ.3) THEN MLREEL=IVLL MLREE1=IVUL MLREE2=IVX0 SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD NN1 = MLREE2.PROG(/1)-1 DO 41 K=1,NN1 PROG(K)=0. MLREE1.PROG(K)=1000.*MLREE2.PROG(K) 41 CONTINUE PROG(N)=0.D0 MLREE1.PROG(N)=XSMAX+1. IF(IIMPI.EQ.1799) WRITE(IOIMP,51)(PROG(K),K=1,N) 51 FORMAT(' VALEUR DE IVLL ',/,(1X,5E12.5)) IF(IIMPI.EQ.1799) WRITE(IOIMP,52)(MLREE1.PROG(K),K=1,N) 52 FORMAT(' VALEUR DE IVUL ',/,(1X,5E12.5)) ENDIF * * partie commune au trois methode : calcul de bornes inf et sup * MLREEL=IVX0 MLREE1=IVLL MLREE3=IVXMIN SEGACT MLREEL*MOD,MLREE1*MOD,MLREE3*MOD JG=N SEGINI MLREE2 IVMIN=MLREE2 DO 3 K=1,N MLREE2.PROG(K)=MLREE3.PROG(K) CTE=0.95*MLREE1.PROG(K) + 0.05* PROG(K) IF( MLREE2.PROG(K).LE.CTE) MLREE2.PROG(K)=CTE 3 CONTINUE MLREE2.PROG(N)=1. MLREE1=IVUL MLREE3=IVXMAX SEGACT MLREE1*MOD,MLREE3*MOD JG=N SEGINI MLREE2 IVMAX=MLREE2 DO 4 K=1,N CTE=0.95*MLREE1.PROG(K) + 0.05 *PROG(K) MLREE2.PROG(K)=MLREE3.PROG(K) IF(MLREE2.PROG(K).GE.CTE) MLREE2.PROG(K)=CTE 4 CONTINUE MLREEL=IVMIN MLREE1=IVXMIN SEGACT MLREEL*MOD,MLREE1*MOD DO 6 K=1,N IF(MLREE1.PROG(K).GT.PROG(K))PROG(K)=MLREE1.PROG(K) 6 CONTINUE MLREEL=IVMAX MLREE1=IVXMAX SEGACT MLREEL*MOD,MLREE1*MOD DO 7 K=1,N IF(MLREE1.PROG(K).LT.PROG(K))PROG(K)=MLREE1.PROG(K) 7 CONTINUE RETURN END