1 : C COURB3 SOURCE PV 07/11/23 21:16:08 5978 2 : SUBROUTINE COURB3 (MCOURB,ALONG,MABCUR) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * C O U R B 3 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * CREATION D'ABSCISSES CURVILIGNES EN UN NOMBRE DISCRET DE POINTS 14 : * DE LA COURBE POLYNOMIALE, ET DE SA LONGUEUR TOTALE APPROXIMATIVE. 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC CCOPTIO 20 : -INC SMCOORD 21 : -INC TMCOURB 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * MCOURB (E) SEGMENT ACTIF. 27 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 28 : * +MCOORD (E) SEGMENT ACTIF. 29 : * ALONG (S) LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE. 30 : * MABCUR (S) POINTEUR DE SEGMENT CONTENANT LES ABSCISSES 31 : * CURVILIGNES EN UN NOMBRE FINI DE POINTS DE LA COURBE 32 : * (DONT LES POINTS EXTREMITES). 33 : * SEGMENT LAISSE DANS L'ETAT ACTIF. 34 : * 35 : SEGMENT,MABCUR 36 : REAL*8 ABCURV(NPDISC) 37 : ENDSEGMENT 38 : * 39 : * VARIABLES: 40 : * ---------- 41 : * 42 : REAL*8 U 43 : * 44 : * CONSTANTES: 45 : * ----------- 46 : * 47 : * NPDISC NOMBRE DE POINTS DE DISCRETISATION DE LA COURBE. 48 : * 49 : INTEGER NPDISC,NPDIS1 50 : PARAMETER (NPDISC = 101, NPDIS1 = NPDISC-1) 51 : * 52 : * FONCTIONS: 53 : * ---------- 54 : * 55 : REAL*8 POLYNO 56 : * 57 : * REMARQUES: 58 : * ---------- 59 : * 60 : * LE REMPLISSAGE DE "ABCURV" NE S'IMPOSE QUE POUR L'OPTION 61 : * "REGULIER" DE L'OPERATEUR "COURBE". 62 : * 63 : * AUTEUR, DATE DE CREATION: 64 : * ------------------------- 65 : * 66 : * PASCAL MANIGOT 10 SEPTEMBRE 1986 67 : * P.M. 24/02/87 : REMODELAGE, AVEC UN NOUVEAU SEGMENT "MCOURB". 68 : * 69 : * LANGAGE: 70 : * -------- 71 : * 72 : * ESOPE + FORTRAN77 + EXTENSION: DECLARATION "REAL*8". 73 : * 74 : ************************************************************************ 75 : * 76 : SEGINI,MABCUR 77 : ABCURV(1) = 0. 78 : U = U1COU 79 : DU = (U2COU - U1COU) / REAL(NPDIS1) 80 : IP = (PT1COU - 1) * (IDIM + 1) 81 : X3COU = XCOOR(IP+1) 82 : Y3COU = XCOOR(IP+2) 83 : Z3COU = XCOOR(IP+3) 84 : IP = (PT2COU - 1) * (IDIM + 1) 85 : X2COU = XCOOR(IP+1) 86 : Y2COU = XCOOR(IP+2) 87 : Z2COU = XCOOR(IP+3) 88 : * 89 : MCOFCO = ICOFCO 90 : SEGACT,MCOFCO 91 : IF (IDIM .EQ. 3) THEN 92 : DO 100 IB=2,NPDIS1 93 : U = U + DU 94 : X4COU = POLYNO (COFCOU(1,1),ND1COU,1,U) 95 : Y4COU = POLYNO (COFCOU(1,2),ND1COU,1,U) 96 : Z4COU = POLYNO (COFCOU(1,3),ND1COU,1,U) 97 : ABCURV(IB) = ABCURV(IB-1) + SQRT((X4COU-X3COU)**2 98 : & + (Y4COU-Y3COU)**2 + (Z4COU-Z3COU)**2) 99 : X3COU = X4COU 100 : Y3COU = Y4COU 101 : Z3COU = Z4COU 102 : 100 CONTINUE 103 : * END DO 104 : ALONG = ABCURV(NPDIS1) + SQRT((X2COU-X3COU)**2 105 : & + (Y2COU-Y3COU)**2 + (Z2COU-Z3COU)**2) 106 : ELSE 107 : DO 110 IB=2,NPDIS1 108 : U = U + DU 109 : X4COU = POLYNO (COFCOU(1,1),ND1COU,1,U) 110 : Y4COU = POLYNO (COFCOU(1,2),ND1COU,1,U) 111 : ABCURV(IB) = ABCURV(IB-1) + SQRT((X4COU-X3COU)**2 112 : & + (Y4COU-Y3COU)**2) 113 : X3COU = X4COU 114 : Y3COU = Y4COU 115 : 110 CONTINUE 116 : * END DO 117 : ALONG = ABCURV(NPDIS1) + SQRT((X2COU-X3COU)**2 118 : & + (Y2COU-Y3COU)**2) 119 : END IF 120 : ABCURV(NPDISC) = ALONG 121 : * 122 : SEGDES,MCOFCO 123 : * 124 : END 125 : 126 :
© Cast3M 2003 - All rights reserved.
Disclaimer