1 : C COURB4 SOURCE PV 07/11/23 21:16:10 5978 2 : SUBROUTINE COURB4 (MCOURB,MABCUR,MABSCI,ALONG) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * C O U R B 4 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * DETERMINATION, A PARTIR D'UNE SUITE DISCRETE D'ABSCISSES 14 : * CURVILIGNES LE LONG DE LA COURBE POLYNOMIALE, DES COORDONNEES 15 : * DE POINTS A DES ABSCISSES CURVILIGNES DONNEES (PAR INTERPOLATION 16 : * LINEAIRE). 17 : * 18 : * MODULES UTILISES: 19 : * ----------------- 20 : * 21 : -INC CCOPTIO 22 : -INC CCGEOME 23 : -INC CCREEL 24 : -INC SMCOORD 25 : -INC TMCOURB 26 : * 27 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 28 : * ----------- 29 : * 30 : * MCOURB (E) SEGMENT ACTIF. 31 : * (S) ETENDU EN SORTIE (TABLEAU "UCOU" REMPLI). 32 : * MABCUR (E) SEGMENT ACTIF DEFINI DANS LE S-P "COURB3". 33 : * MABSCI (E) SEGMENT ACTIF DEFINI DANS LE S-P "COURB2". 34 : * ICI, IL S'AGIT D'ABSCISSES CURVILIGNES. 35 : * ALONG (E) LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE. 36 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 37 : * +ILCOUR (E) VOIR LE COMMUN "CGEOME". 38 : * +XPETIT (E) VOIR LE COMMUN "CREEL". 39 : * +MCOORD (E) SEGMENT ACTIF. 40 : * (S) COMPLETE EN SORTIE. 41 : * 42 : SEGMENT,MABCUR 43 : REAL*8 ABCURV(NPDISC) 44 : ENDSEGMENT 45 : SEGMENT,MABSCI 46 : REAL*8 ABSCIS(NPOIN) 47 : ENDSEGMENT 48 : * 49 : * VARIABLES: 50 : * ---------- 51 : * 52 : * COFDEN = FACTEUR CORRECTIF DE LA DENSITE LOCALE CALCULEE, SELON 53 : * LE TYPE D'ELEMENT (SEG2 OU SEG3). 54 : * 55 : REAL*8 COFDEN 56 : REAL*8 U 57 : * 58 : * FONCTIONS: 59 : * ---------- 60 : * 61 : REAL*8 POLYNO 62 : * 63 : * REMARQUES: 64 : * ---------- 65 : * 66 : * CE SOUS-PROGRAMME N'EST PAS PREVU POUR FONCTIONNER AVEC UN NOMBRE 67 : * DE POINTS NUL. 68 : * 69 : * AUTEUR, DATE DE CREATION: 70 : * ------------------------- 71 : * 72 : * PASCAL MANIGOT 10 SEPTEMBRE 1986 73 : * P.M. 24/02/87 : REMODELAGE, AVEC UN NOUVEAU SEGMENT "MCOURB". 74 : * 75 : * LANGAGE: 76 : * -------- 77 : * 78 : * ESOPE + FORTRAN77 79 : * 80 : ************************************************************************ 81 : * 82 : NPOIN = ABSCIS(/1) 83 : NPDISC = ABCURV(/1) 84 : DU = (U2COU - U1COU) / REAL(NPDISC-1) 85 : * 86 : IF (ILCOUR .EQ. 2) THEN 87 : COFDEN = 0.5 88 : ELSE 89 : * "ILCOUR" EST SUPPOSE VALOIR 3. 90 : COFDEN = 1. 91 : END IF 92 : ABSC1 = 0. 93 : ABSC2 = ABSCIS(1) 94 : * 95 : LONG = NPOIN 96 : SEGADJ,MCOURB 97 : IDIMP1 = IDIM + 1 98 : NBPTA=XCOOR(/1)/IDIMP1 99 : NBPTS=NBPTA+NPOIN 100 : SEGADJ MCOORD 101 : MCOFCO = ICOFCO 102 : SEGACT,MCOFCO 103 : * 104 : DO 200 IB=1,NPOIN 105 : * 106 : * POUR UN POINT A ETUDIER, DETERMINATION DE 2 POINTS DE 107 : * COORDONNEES PARAMETRIQUES CONNUES ET L'ENCADRANT SUR LA COURBE. 108 : * 109 : ABSC0 = ABSC1 110 : ABSC1 = ABSC2 111 : IF (IB .EQ. NPOIN) THEN 112 : ABSC2 = ALONG 113 : ELSE 114 : ABSC2 = ABSCIS(IB+1) 115 : END IF 116 : * 117 : DO 210 IB2=2,NPDISC 118 : IF (ABSC1 .LE. ABCURV(IB2)) THEN 119 : * --> SORTIE DE BOUCLE 120 : GOTO 212 121 : END IF 122 : 210 CONTINUE 123 : * END DO 124 : IB2 = NPDISC 125 : *+* VAUDRAIT-IL MIEUX UN MESSAGE D'ERREUR ? 126 : 212 CONTINUE 127 : * 128 : * CALCUL DE LA COORDONNEE INTRINSEQUE PAR INTERPOLATION LINEAIRE 129 : * 130 : COFDIV = ABCURV(IB2) - ABCURV(IB2-1) 131 : IF (ABS(COFDIV) .LE. XPETIT) THEN 132 : * LA PORTION DE COURBE EST DE LONGUEUR NULLE. L'ABSCISSE 133 : * CURVILIGNE RESTE PRATIQUEMENT CONSTANTE. 134 : COF = 0. 135 : ELSE 136 : COF = (ABSC1 - ABCURV(IB2-1)) / COFDIV 137 : END IF 138 : U = U1COU + DU*REAL(IB2-2) + DU*COF 139 : * 140 : * CALCUL DES COORDONNEES. 141 : * 142 : XCOOR(NBPTA*IDIMP1+1) = POLYNO (COFCOU(1,1),ND1COU,1,U) 143 : XCOOR(NBPTA*IDIMP1+2) = POLYNO (COFCOU(1,2),ND1COU,1,U) 144 : IF (IDIM .EQ. 3) 145 : # XCOOR(NBPTA*IDIMP1+3) = POLYNO (COFCOU(1,3),ND1COU,1,U) 146 : XCOOR(NBPTA*IDIMP1+IDIMP1) = (ABSC2 - ABSC0) * COFDEN 147 : NBPTA=NBPTA+1 148 : * 149 : *+* ON POURRAIT ENVISAGER UN PETIT SCHEMA ITERATIF POUR QUE 150 : *+* L'INTERPOLATION SOIT LINEAIRE SUIVANT L'ABSCISSE CURVILIGNE. 151 : * 152 : UCOU(IB) = U 153 : * 154 : 200 CONTINUE 155 : * END DO 156 : * 157 : SEGDES,MCOFCO 158 : * 159 : END 160 : 161 : 162 : 163 : 164 : 165 : 166 : 167 : 168 : 169 :
© Cast3M 2003 - All rights reserved.
Disclaimer