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