Sources Esope | Cast3M

chglim
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 PPARAM
-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