Télécharger la plaquette Cast3M


fr en

Télécharger maxevo.eso

Retour à la liste

Numérotation des lignes : 

maxevo

  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