Télécharger borne3.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales