1 : C COURB5 SOURCE PV 07/11/23 21:16:12 5978 2 : SUBROUTINE COURB5 (MCOURB,MABSCI) 3 : ************************************************************************ 4 : * 5 : * C O U R B 5 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * CALCUL DES COORDONNEES DES NOUVEAUX POINTS CREES POUR LA COURBE 12 : * POLYNOMIALE, COURBE POUR LAQUELLE IL N'AVAIT PAS ETE DEMANDE DE 13 : * REGULARITE SELON L'ABSCISSE CURVILIGNE. 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : IMPLICIT INTEGER(I-N) 19 : IMPLICIT real*8 (a-h,o-z) 20 : -INC CCOPTIO 21 : -INC CCGEOME 22 : -INC SMCOORD 23 : -INC TMCOURB 24 : * 25 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 26 : * ----------- 27 : * 28 : * MCOURB (E) SEGMENT ACTIF. 29 : * (S) ETENDU EN SORTIE (TABLEAU "UCOU" REMPLI). 30 : * MABSCI (E) SEGMENT ACTIF, DEFINI DANS LE S-P "COURB2". 31 : * ICI, IL S'AGIT D'ABSCISSES PARAMETRIQUES. 32 : * +IDIM (E) VOIR LE COMMUN "COPTIO". 33 : * +ILCOUR (E) VOIR LE COMMUN "CGEOME". 34 : * +MCOORD (E) SEGMENT ACTIF. 35 : * (S) ETENDU EN SORTIE. 36 : * 37 : SEGMENT,MABSCI 38 : REAL*8 ABSCIS(NPOIN) 39 : ENDSEGMENT 40 : * 41 : * VARIABLES: 42 : * ---------- 43 : * 44 : * D1 = DISTANCE DU POINT COURANT AVEC LE POINT PRECEDENT. 45 : * D3 = DISTANCE DU POINT COURANT AVEC LE POINT SUIVANT. 46 : * NPOLD = NOMBRE DE POINTS AVANT AJOUT. 47 : * NPOIN = NOMBRE DE POINTS A AJOUTER. 48 : * U2 = PARAMETRE DU POINT COURANT. 49 : * UINF, USUP = BORNES ENCADRANT LE PARAMETRE DU POINT-MILIEU 50 : * COURANT. 51 : * 52 : * EN GENERAL, INDICE 1 POUR POINT PRECEDENT, INDICE 2 POUR POINT 53 : * COURANT ET INDICE 3 POUR POINT SUIVANT. 54 : * 55 : INTEGER NPOLD,NPOIN 56 : REAL*8 USUP,UINF,D1,D3 57 : REAL*8 U2 58 : * 59 : * FONCTIONS: 60 : * ---------- 61 : * 62 : REAL*8 POLYNO 63 : * 64 : * REMARQUES: 65 : * ---------- 66 : * 67 : * CE SOUS-PROGRAMME N'EST PAS PREVU POUR FONCTIONNER AVEC UN NOMBRE 68 : * DE POINTS NUL. 69 : * 70 : * AUTEUR, DATE DE CREATION: 71 : * ------------------------- 72 : * 73 : * PASCAL MANIGOT 10 SEPTEMBRE 1986 74 : * P.M. 24/02/87 : REMODELAGE, AVEC UN NOUVEAU SEGMENT "MCOURB". 75 : * 76 : * LANGAGE: 77 : * -------- 78 : * 79 : * ESOPE77 FORTRAN77 + EXTENSION: DECLARATION "REAL*8". 80 : * 81 : ************************************************************************ 82 : * 83 : NPOIN = ABSCIS(/1) 84 : IDIMP1 = IDIM + 1 85 : NPOLD = XCOOR(/1) / IDIMP1 86 : * 87 : * DETERMINATION DES COORDONNEES DES NOUVEAUX POINTS. 88 : * 89 : LONG = NPOIN 90 : SEGADJ,MCOURB 91 : NBPTA = NPOLD 92 : NBPTS=NBPTA+NPOIN 93 : SEGADJ MCOORD 94 : MCOFCO = ICOFCO 95 : SEGACT,MCOFCO 96 : * 97 : DO 300 IB=1,NPOIN 98 : U2 = ABSCIS(IB) 99 : UCOU(IB) = U2 100 : XCOOR(NBPTA*IDIMP1+1) = POLYNO (COFCOU(1,1),ND1COU,1,U2) 101 : XCOOR(NBPTA*IDIMP1+2) = POLYNO (COFCOU(1,2),ND1COU,1,U2) 102 : IF (IDIM .EQ. 3) 103 : # XCOOR(NBPTA*IDIMP1+3) = POLYNO (COFCOU(1,3),ND1COU,1,U2) 104 : NBPTA=NBPTA+1 105 : 300 CONTINUE 106 : * END DO 107 : * 108 : IF (ILCOUR .EQ. 3) THEN 109 : * 110 : * AJUSTEMENT DE LA PLACE DES POINTS-MILIEUX POUR QU'ILS SOIENT 111 : * BIEN ... AU MILIEU DES ELEMENTS. 112 : * LES POINTS-MILIEUX SONT AUX PLACES 1, 3, ... , NPOIN (AU 113 : * COEFFICIENT MULTIPLICATIF IDIM+1 PRES) DANS LA PARTIE AJOUTEE 114 : * DE "XCOOR". 115 : * ON EN PROFITE POUR INSCRIRE LA DENSITE DES POINTS-MILIEUX. 116 : * 117 : I3 = (PT1COU - 1) * IDIMP1 118 : X3 = XCOOR(I3+1) 119 : Y3 = XCOOR(I3+2) 120 : IF (IDIM .EQ. 3) Z3 = XCOOR(I3+3) 121 : U3 = U1COU 122 : * 123 : DO 310 IB=1,NPOIN,2 124 : * 125 : U1 = U3 126 : X1 = X3 127 : Y1 = Y3 128 : I2 = (IB + NPOLD - 1) * IDIMP1 129 : U2 = ABSCIS(IB) 130 : X2 = XCOOR(I2+1) 131 : Y2 = XCOOR(I2+2) 132 : IF (IB .EQ. NPOIN) THEN 133 : I3 = (PT2COU - 1) * IDIMP1 134 : U3 = U2COU 135 : ELSE 136 : I3 = (IB + NPOLD) * IDIMP1 137 : U3 = ABSCIS(IB+1) 138 : END IF 139 : X3 = XCOOR(I3+1) 140 : Y3 = XCOOR(I3+2) 141 : IF (IDIM .EQ. 3) THEN 142 : Z1 = Z3 143 : Z2 = XCOOR(I2+3) 144 : Z3 = XCOOR(I3+3) 145 : D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 + (Z2-Z1)**2 ) 146 : D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 + (Z2-Z3)**2 ) 147 : ELSE 148 : D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 ) 149 : D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 ) 150 : END IF 151 : UINF = U1 152 : USUP = U3 153 : * 154 : NFOIS = 0 155 : 315 IF (ABS(D3-D1) .GT. (0.1*(D1+D3)) .AND. NFOIS.LT.5) THEN 156 : * 157 : IF (D1 .GT. D3) THEN 158 : USUP = U2 159 : ELSE 160 : UINF = U2 161 : END IF 162 : U2 = (UINF + USUP) / 2. 163 : X2 = POLYNO (COFCOU(1,1),ND1COU,1,U2) 164 : Y2 = POLYNO (COFCOU(1,2),ND1COU,1,U2) 165 : IF (IDIM .EQ. 3) THEN 166 : Z2 = POLYNO (COFCOU(1,3),ND1COU,1,U2) 167 : D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 + (Z2-Z1)**2 ) 168 : D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 + (Z2-Z3)**2 ) 169 : ELSE 170 : D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 ) 171 : D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 ) 172 : END IF 173 : NFOIS = NFOIS + 1 174 : * 175 : GOTO 315 176 : END IF 177 : * 178 : IF (NFOIS .GT. 0) THEN 179 : * RECTIFICATION DES COORDONNEES ET DU PARAMETRE: 180 : XCOOR(I2+1) = X2 181 : XCOOR(I2+2) = Y2 182 : IF (IDIM .EQ. 3) XCOOR(I2+3) = Z2 183 : UCOU(IB) = U2 184 : END IF 185 : XCOOR(I2+IDIMP1) = D1 + D3 186 : * CI-DESSUS, ON NE DIVISE PAS PAR 2 CAR, POUR UN "SEG3", IL NE 187 : * FAUT PAS CONFONDRE LARGEUR DE MAILLE ET DISTANCE ENTRE 2 188 : * POINTS. 189 : IF (IIMPI .EQ. 342) WRITE (IOIMP,*) 'NFOIS = ',NFOIS 190 : * 191 : 310 CONTINUE 192 : * END DO 193 : * 194 : * LA BOUCLE 330 VA TRAITER LES POINTS NOUVEAUX N. 2, 4, 6, ... 195 : IB1 = 2 196 : IB2 = NPOIN - 1 197 : IB3 = 2 198 : * 199 : ELSE 200 : * ILCOUR = 2 201 : * 202 : * LA BOUCLE 330 VA TRAITER TOUS LES POINTS NOUVEAUX. 203 : IB1 = 1 204 : IB2 = NPOIN 205 : IB3 = 1 206 : * 207 : END IF 208 : * 209 : SEGDES,MCOFCO 210 : * 211 : * DETERMINATION DES DENSITES DES EXTREMITES DES SEGMENTS: 212 : * 213 : IF (IB1 .LE. IB2) THEN 214 : I2 = (PT1COU - 1) * IDIMP1 215 : I3 = (IB1 + NPOLD - 1) * IDIMP1 216 : D3 = (XCOOR(I3+1) - XCOOR(I2+1) ) ** 2 217 : & + (XCOOR(I3+2) - XCOOR(I2+2) ) ** 2 218 : IF (IDIM .EQ. 3) D3 = D3 + (XCOOR(I3+3) - XCOOR(I2+3) )**2 219 : D3 = SQRT(D3) 220 : DO 330 IB=IB1,IB2,IB3 221 : I2 = I3 222 : IF (IB .EQ. IB2) THEN 223 : I3 = (PT2COU - 1) * IDIMP1 224 : ELSE 225 : I3 = (IB + NPOLD - 1 + IB3) * IDIMP1 226 : END IF 227 : D1 = D3 228 : D3 = (XCOOR(I3+1) - XCOOR(I2+1) ) ** 2 229 : & + (XCOOR(I3+2) - XCOOR(I2+2) ) ** 2 230 : IF (IDIM .EQ. 3) D3 = D3 + (XCOOR(I3+3) - XCOOR(I2+3) )**2 231 : D3 = SQRT(D3) 232 : XCOOR(I2+IDIMP1) = (D1 + D3) / 2. 233 : 330 CONTINUE 234 : * END DO 235 : END IF 236 : * 237 : END 238 : 239 : 240 : 241 : 242 : 243 : 244 : 245 :
© Cast3M 2003 - All rights reserved.
Disclaimer