Télécharger maxevo.eso

Retour à la liste

Numérotation des lignes :

  1. C MAXEVO SOURCE BP208322 16/11/18 21:19:08 9177
  2. INTEGER FUNCTION MAXEVO (ICOURB)
  3. ************************************************************************
  4. *
  5. * M A X E V O
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * ANALOGUE AU "MAX" FORTRAN, APPLIQUE AUX OBJETS "EVOLUTIO":
  12. *
  13. * CREER LA COURBE "ENVELOPPE" D'UN ENSEMBLE DE COURBES PAR
  14. * PRELEVEMENT, POUR CHAQUE ABSCISSE, DU MAXIMUM DES ORDONNEES DES
  15. * DIFFERENTES COURBES.
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20. IMPLICIT INTEGER(I-N)
  21. -INC CCGEOME
  22. -INC SMEVOLL
  23. *
  24. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  25. * -----------
  26. *
  27. * ICOURB (E) OBJET "EVOLUTIO" COMPLEXE CONTENANT LA LISTE DES
  28. * COURBES DONT VEUT L'ENVELOPPE.
  29. * MAXEVO (S) OBJET "EVOLUTIO" SIMPLE CONTENANT L'ENVELOPPE.
  30. *
  31. * VARIABLES:
  32. * ----------
  33. *
  34. POINTEUR MMAXI.MEVOLL,KMAXI.KEVOLL
  35. *
  36. * MODE DE FONCTIONNEMENT:
  37. * -----------------------
  38. *
  39. * LA LISTE DES ABSCISSES DE L'ENVELOPPE EST LA REUNION DES ABSCISSES
  40. * DE DEFINITION DE CHAQUE COURBE.
  41. *
  42. * ON UTILISE L'INTERPOLATION ET L'EXTRAPOLATION LINEAIRES POUR
  43. * DETERMINER L'ENVELOPPE D'UN ENSEMBLE DE COURBES NON DEFINIES AUX
  44. * MEMES POINTS.
  45. *
  46. * ON SUPPOSE QUE CHAQUE COURBE EST DEFINIE PAR UNE SUITE DE COUPLES
  47. * FOURNIS PAR ABSCISSES STRICTEMENT CROISSANTES.
  48. *
  49. * REMARQUES:
  50. * ----------
  51. *
  52. * ON TIENT COMPTE DU FAIT QUE LE SOUS-PROGRAMME D'INTERPOLATION
  53. * "INTE33" SAIT AUSSI EXTRAPOLER LINEAIREMENT.
  54. *
  55. * AUTEUR, DATE DE CREATION:
  56. * -------------------------
  57. *
  58. * PASCAL MANIGOT 9 SEPTEMBRE 1988
  59. *
  60. * LANGAGE:
  61. * --------
  62. *
  63. * ESOPE + FORTRAN77
  64. *
  65. ************************************************************************
  66. *
  67. MEVOLL = ICOURB
  68. SEGACT,MEVOLL
  69. NCOURB = IEVOLL(/1)
  70. *
  71. IF (NCOURB .LE. 0) THEN
  72. MAXEVO = 0
  73. SEGDES,MEVOLL
  74. RETURN
  75. END IF
  76. *
  77. N = 1
  78. SEGINI,MMAXI
  79. MAXEVO = MMAXI
  80. MMAXI.ITYEVO = ITYEVO
  81. MMAXI.IEVTEX = IEVTEX
  82. KEVOLL = IEVOLL(1)
  83. SEGINI,KMAXI=KEVOLL
  84. MMAXI.IEVOLL(1) = KMAXI
  85. KMAXI.NUMEVX = IDCOUL
  86. *
  87. IF (NCOURB .EQ. 1) THEN
  88. SEGDES,MMAXI,KMAXI
  89. SEGDES,MEVOLL
  90. RETURN
  91. END IF
  92. *
  93. KMAXI.KEVTEX = 'ENVELOPPE'
  94. *
  95. *
  96. * 1) CREATION DE LA LISTE DES ABSCISSES DE LA COURBE ENVELOPPE
  97. *
  98. SEGACT,KEVOLL
  99. IXX9 = IPROGX
  100. *
  101. DO 100 IB=2,NCOURB
  102. KEVOLL = IEVOLL(IB)
  103. SEGACT,KEVOLL
  104. IXX1 = IXX9
  105. IXX2 = IPROGX
  106. CALL FUSLRE (IXX1,IXX2, IXX9)
  107. IF (IB .GT. 2) THEN
  108. CALL DTLREE (IXX1)
  109. END IF
  110. 100 CONTINUE
  111. * END DO
  112. *
  113. KMAXI.IPROGX = IXX9
  114. * ON NE DESACTIVE PAS LES "KEVOLL": ILS SERVENT CI-DESSOUS.
  115. *
  116. *
  117. * 2) CREATION DE LA LISTE DES ORDONNEES DE L'ENVELOPPE
  118. *
  119. DO 200 IB=1,NCOURB
  120. KEVOLL = IEVOLL(IB)
  121. *
  122. * DEFINITION DE LA COURBE "IB" AVEC LA PRECISION DE L'ENVELOPPE:
  123. IPR0GX = IPROGX
  124. IPR0GY = IPROGY
  125. CALL INTE33 (IPR0GX,IPR0GY,IXX9, IYY1)
  126. *
  127. IF (IB .GT. 1) THEN
  128. * ENVELOPPE DES COURBES 1 A "IB":
  129. IYY2 = MAXLRE (IYY9,IYY1)
  130. CALL DTLREE (IYY1)
  131. CALL DTLREE (IYY9)
  132. IYY9 = IYY2
  133. ELSE
  134. IYY9 = IYY1
  135. END IF
  136. *
  137. SEGDES,KEVOLL
  138. 200 CONTINUE
  139. * END DO
  140. *
  141. KMAXI.IPROGY = IYY9
  142. *
  143. SEGDES,MEVOLL
  144. SEGDES,KMAXI,MMAXI
  145. *
  146. END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  

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