Download borne3.eso

Back to the list

   1 : C BORNE3    SOURCE    FANDEUR   11/04/12    21:15:06     6938           
   2 : 
   3 :       SUBROUTINE BORNE3 (IEVOLE,MLIEVO,MLIOPE,MLBMIN,MLBMAX, IEVOLS)
   4 : 
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : 
   8 : -INC CCOPTIO
   9 : -INC SMEVOLL
  10 : -INC SMLENTI
  11 : -INC SMLREEL
  12 : 
  13 : C- Activation de l'evolution en entree
  14 :       MEVOL1 = IEVOLE
  15 :       SEGACT,MEVOL1
  16 :       NCOUR = MEVOL1.IEVOLL(/1)
  17 : 
  18 : C- Creation de l'evolution resultat
  19 :       IEVOLS = 0
  20 :       SEGINI,MEVOLL=MEVOL1
  21 : 
  22 : C- Quelques verifications
  23 :       MLENTI = MLIEVO
  24 : C*    SEGACT,MLENTI
  25 :       DO i = 1, LECT(/1)
  26 :         icour = LECT(i)
  27 :         IF (icour.LE.0) THEN
  27 :           CALL ERREUR(352)
  28 :         ELSE IF (icour.GT.NCOUR) THEN
  29 :           INTERR(1) = icour
  29 :           CALL ERREUR(351)
  30 :         ELSE
  31 :           DO j = 1, i-1
  32 :             IF (icour.EQ.LECT(j)) LECT(j) = 0
  33 :           ENDDO
  34 :         ENDIF
  35 :       ENDDO
  36 :       IF (IERR.NE.0) GOTO 900
  37 :       N = 0
  38 :       DO i = 1, LECT(/1)
  39 :         IF (LECT(i).NE.0) N = N+1
  40 :       ENDDO
  40 :       IF (N.EQ.0) CALL ERREUR(5)
  41 :       IF (N.NE.NCOUR) SEGADJ,MEVOLL
  42 : 
  43 : C- Realisation du bornage des courbes
  44 :       MLENT1 = MLIOPE
  45 : C*    SEGACT,MLENT1
  46 :       MLREE1 = MLBMIN
  47 : C*    SEGACT,MLREE1
  48 :       MLREE2 = MLBMAX
  49 : C*    SEGACT,MLREE2
  50 : 
  51 :       N = 0
  52 :       DO i = 1, LECT(/1)
  53 :         icour = LECT(i)
  54 :         IF (icour.NE.0) THEN
  55 :           N = N+1
  56 :           KEVOL1 = MEVOL1.IEVOLL(icour)
  57 :           SEGINI,KEVOLL=KEVOL1
  58 :           ILREEE = IPROGY
  59 :           INDOPE = MLENT1.LECT(i)
  60 :           XBMIN  = MLREE1.PROG(i)
  61 :           XBMAX  = MLREE2.PROG(i)
  61 :           CALL BORNE2(ILREEE,INDOPE,XBMIN,XBMAX,ILREES)
  62 :           IPROGY = ILREES
  63 :           SEGDES,KEVOLL
  64 :           IEVOLL(N) = KEVOLL
  65 :         ENDIF
  66 :       ENDDO
  67 : 
  68 :       IEVOLS = MEVOLL
  69 : 
  70 :  900  CONTINUE
  71 :       IF (IEVOLS.NE.0) THEN
  72 :         SEGDES,MEVOLL
  73 :       ELSE
  74 :         SEGSUP,MEVOLL
  75 :       ENDIF
  76 :       SEGDES,MEVOL1
  77 : 
  78 :       RETURN
  79 :       END
  80 : 
  81 :  
  82 :  

© Cast3M 2003 - All rights reserved.
Disclaimer