1 : C MAXEVO SOURCE CHAT 07/10/29 21:24:05 5940 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 105 : CALL FUSLRE (IXX1,IXX2, IXX9) 106 : IF (IB .GT. 2) THEN 106 : CALL DTLREE (IXX1) 107 : END IF 108 : 100 CONTINUE 109 : * END DO 110 : * 111 : KMAXI.IPROGX = IXX9 112 : * ON NE DESACTIVE PAS LES "KEVOLL": ILS SERVENT CI-DESSOUS. 113 : * 114 : * 115 : * 2) CREATION DE LA LISTE DES ORDONNEES DE L'ENVELOPPE 116 : * 117 : DO 200 IB=1,NCOURB 118 : KEVOLL = IEVOLL(IB) 119 : * 120 : * DEFINITION DE LA COURBE "IB" AVEC LA PRECISION DE L'ENVELOPPE: 121 : IPR0GX = IPROGX 122 : IPR0GY = IPROGY 122 : CALL INTE33 (IPR0GX,IPR0GY,IXX9, IYY1) 123 : * 124 : IF (IB .GT. 1) THEN 125 : * ENVELOPPE DES COURBES 1 A "IB": 126 : IYY2 = MAXLRE (IYY9,IYY1) 126 : CALL DTLREE (IYY1) 126 : CALL DTLREE (IYY9) 127 : IYY9 = IYY2 128 : ELSE 129 : IYY9 = IYY1 130 : END IF 131 : * 132 : SEGDES,KEVOLL 133 : 200 CONTINUE 134 : * END DO 135 : * 136 : KMAXI.IPROGY = IYY9 137 : * 138 : SEGDES,MEVOLL 139 : SEGDES,KMAXI,MMAXI 140 : * 141 : END 142 : 143 : 144 : 145 : 146 : 147 :
© Cast3M 2003 - All rights reserved.
Disclaimer