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. -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
  28. CALL ERREUR(352)
  29. ELSE IF (icour.GT.NCOUR) THEN
  30. INTERR(1) = icour
  31. CALL ERREUR(351)
  32. ELSE
  33. DO j = 1, i-1
  34. IF (icour.EQ.LECT(j)) LECT(j) = 0
  35. ENDDO
  36. ENDIF
  37. ENDDO
  38. IF (IERR.NE.0) GOTO 900
  39. N = 0
  40. DO i = 1, LECT(/1)
  41. IF (LECT(i).NE.0) N = N+1
  42. ENDDO
  43. IF (N.EQ.0) CALL ERREUR(5)
  44. IF (N.NE.NCOUR) SEGADJ,MEVOLL
  45.  
  46. C- Realisation du bornage des courbes
  47. MLENT1 = MLIOPE
  48. C* SEGACT,MLENT1
  49. MLREE1 = MLBMIN
  50. C* SEGACT,MLREE1
  51. MLREE2 = MLBMAX
  52. C* SEGACT,MLREE2
  53.  
  54. N = 0
  55. DO i = 1, LECT(/1)
  56. icour = LECT(i)
  57. IF (icour.NE.0) THEN
  58. N = N+1
  59. KEVOL1 = MEVOL1.IEVOLL(icour)
  60. SEGINI,KEVOLL=KEVOL1
  61. ILREEE = IPROGY
  62. INDOPE = MLENT1.LECT(i)
  63. XBMIN = MLREE1.PROG(i)
  64. XBMAX = MLREE2.PROG(i)
  65. CALL BORNE2(ILREEE,INDOPE,XBMIN,XBMAX,ILREES)
  66. IPROGY = ILREES
  67. SEGDES,KEVOLL
  68. IEVOLL(N) = KEVOLL
  69. ENDIF
  70. ENDDO
  71.  
  72. IEVOLS = MEVOLL
  73.  
  74. 900 CONTINUE
  75. IF (IEVOLS.NE.0) THEN
  76. SEGDES,MEVOLL
  77. ELSE
  78. SEGSUP,MEVOLL
  79. ENDIF
  80. SEGDES,MEVOL1
  81.  
  82. RETURN
  83. END
  84.  
  85.  
  86.  
  87.  

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