1 : C COURBE SOURCE CHAT 05/01/12 22:25:31 5004 2 : SUBROUTINE COURBE 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * C O U R B E 8 : * ----------- 9 : * 10 : * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "COURBE" 11 : * 12 : * FONCTION: 13 : * --------- 14 : * 15 : * CREATION D'UNE COURBE POLYNOMIALE, C'EST-A-DIRE DONT LES POINTS 16 : * "P" VERIFIENT UNE EQUATION: 17 : * 18 : * 2 3 19 : * P(U) = P0 + U.P1 + U .P2 + U .P3 + ... 20 : * 21 : * PHRASE D'APPEL (EN GIBIANE): 22 : * ---------------------------- 23 : * 24 : * LILI = COURBE (N) (DINI DENS1) (DFIN DENS2) (PINI OB1) (PFIN OB2) 25 : * P0 P1 (P2 (P3 ...) ) (PARAMETRE U1 U2) (REGULIER) ; 26 : * 27 : * OPERANDES ET RESULTATS: 28 : * ----------------------- 29 : * 30 : * LILI 'MAILLAGE' MAILLAGE RESULTANT DE L'OPERATION. OUTRE LA 31 : * COURBE POLYNOMIALE NOUVELLEMENT CREEE, CE 32 : * MAILLAGE COMPRENDRA "OB1" ET/OU "OB2", QUE 33 : * CE SOIENT DES 'POINTS' OU DES 'MAILLAGE'. 34 : * N 'ENTIER ' NOMBRE D'ELEMENTS GEOMETRIQUES DEMANDE. 35 : * > 0 : LONGUEURS EGALES DES ELEMENTS. 36 : * < 0 : LONGUEURS DES ELEMENTS FONCTIONS DES 37 : * DENSITES DES EXTREMITES DE LA COURBE. 38 : * DINI 'MOT ' 39 : * DENS1 'FLOTTANT' DENSITE DEMANDEE POUR LE 1ER ELEMENT. 40 : * DFIN 'MOT ' 41 : * DENS2 'FLOTTANT' DENSITE DEMANDEE POUR LE DERNIER ELEMENT. 42 : * PINI 'MOT ' 43 : * OB1 'POINT ' POINT INITIAL DE LA COURBE: SERA 44 : * EFFECTIVEMENT PRIS COMME TEL SI SES 45 : * COORDONNEES S'OBTIENNENT POUR LA VALEUR "U1" 46 : * (VOIR DEFINITION PLUS LOIN). 47 : * OU 'MAILLAGE' LE POINT FINAL DE CET OBJET "OB1" (FORCEMENT 48 : * UNE LIGNE) SERA LE POINT INITIAL DE LA 49 : * COURBE (AVEC LES MEMES RESERVES QUE 50 : * CI-DESSUS) ET "LILI" CONTIENDRA "OB1". 51 : * PFIN 'MOT ' 52 : * OB2 'POINT ' POINT FINAL DE LA COURBE: SERA EFFECTIVEMENT 53 : * PRIS COMME TEL SI SES COORDONNEES 54 : * S'OBTIENNENT POUR LA VALEUR "U2" (VOIR 55 : * DEFINITION PLUS LOIN). 56 : * OU 'MAILLAGE' LE POINT INITIAL DE CET OBJET "OB2" 57 : * (FORCEMENT UNE LIGNE) SERA LE POINT FINAL 58 : * DE LA COURBE (AVEC LES MEMES RESERVES QUE 59 : * CI-DESSUS) ET "LILI" CONTIENDRA "OB2". 60 : * P0, P1, 'POINT ' POINTS DE LA REPRESENTATION POLYNOMIALE DE 61 : * P2, ... LA COURBE. 62 : * CES POINTS NE FONT PAS PARTIE DE LA COURBE. 63 : * "P0" ET "P1" SONT OBLIGATOIRES. 64 : * PARAMETR 'MOT ' 65 : * U1, U2 'FLOTTANT' BORNES DU PARAMETRE "U" DU POLYNOME DE LA 66 : * COURBE. 67 : * = (0,1) PAR DEFAUT. 68 : * REGULIER 'MOT ' INDIQUE QUE LA COURBE DEVRA ETRE SUBDIVISEE 69 : * EN ELEMENTS DONT LES LONGUEURS SERONT 70 : * ETABLIES SELON L'ABSCISSE CURVILIGNE ET NON 71 : * PAS SELON LE PARAMETRE "U". 72 : * 73 : * MODULES UTILISES: 74 : * ----------------- 75 : * 76 : -INC CCOPTIO 77 : -INC CCREEL 78 : -INC SMCOORD 79 : -INC TMCOURB 80 : * 81 : * VARIABLES: 82 : * ---------- 83 : * 84 : * BIDSP, BIDDP = VARIABLES UTILISEES POUR RESOUDRE DES PROBLEMES DE 85 : * LECTURES DE REELS, TANTOT EN S.P., TANTOT EN D.P., 86 : * ET, PEUT-ETRE, BIENTOT EN ON-NE-SAIT-QUOI. 87 : * 88 : SEGMENT,MTEMP 89 : INTEGER ITEMP(2) 90 : ENDSEGMENT 91 : * 92 : * CONSTANTES: 93 : * ----------- 94 : * 95 : * MOTCLE LISTE DES MOTS-CLES RECONNUS. 96 : * 97 : INTEGER LMOTCL 98 : PARAMETER (LMOTCL = 6) 99 : CHARACTER*4 MOTCLE(LMOTCL) 100 : * 101 : * AUTEUR, DATE DE CREATION: 102 : * ------------------------- 103 : * 104 : * PASCAL MANIGOT 11 SEPTEMBRE 1986 105 : * P.M. 25/02/87 : REPRISE. 106 : * 107 : * LANGAGE: 108 : * -------- 109 : * 110 : * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS 111 : * 112 : ************************************************************************ 113 : * 114 : REAL*8 RBID(1) 115 : DIMENSION IBID(1) 116 : DATA MOTCLE/'DINI','DFIN','PINI','PFIN','PARA','REGU'/ 117 : * 118 : LONG = 0 119 : SEGINI,MCOURB 120 : * 121 : * -- LECTURE DES PARAMETRES PARTICULIERS -- 122 : * 123 : * FACTEUR DE DECOUPAGE: 123 : CALL LIRENT (I,0,IRETOU) 124 : IF (IRETOU .EQ. 1) THEN 125 : NLMCOU = I 126 : ELSE 127 : NLMCOU = 0 128 : END IF 129 : * 130 : U1COU = 0.D0 131 : U2COU = 1.D0 132 : D1COU = 0. 133 : D2COU = 0. 134 : PT1COU = 0 135 : LI1COU = 0 136 : PT2COU = 0 137 : LI2COU = 0 138 : REGCOU = .FALSE. 139 : * 140 : * DO 141 : 205 CONTINUE 142 : * 143 : IRETOU = 0 143 : CALL LIRMOT (MOTCLE,LMOTCL,IRETOU,0) 144 : IF (IRETOU .LE. 0) THEN 145 : * --> SORTIE DE BOUCLE 146 : GOTO 206 147 : END IF 148 : * 149 : GOTO (101,102,103,104,105,106) IRETOU 150 : 101 CONTINUE 150 : CALL LIRE04 (XPETIT,BIDDP,0,1,IRETOU) 151 : IF (IERR .NE. 0) RETURN 152 : D1COU = BIDDP 153 : GOTO 200 154 : 102 CONTINUE 154 : CALL LIRE04 (XPETIT,BIDDP,0,1,IRETOU) 155 : IF (IERR .NE. 0) RETURN 156 : D2COU = BIDDP 157 : GOTO 200 158 : 103 CONTINUE 159 : * IL FAUT ESSAYER DE LIRE UN "MAILLAGE" AVANT UN "POINT" POUR 160 : * NE PAS LIRE PAR ERREUR LES POINTS-COEFFICIENTS DU POLYNOME. 161 : IRETOU = 0 161 : CALL LIROBJ ('MAILLAGE',I,0,IRETOU) 162 : IF (IRETOU .EQ. 1) THEN 163 : LI1COU = I 164 : ELSE 164 : CALL LIROBJ ('POINT',I,1,IRETOU) 165 : IF (IERR .NE. 0) RETURN 166 : PT1COU = I 167 : END IF 168 : GOTO 200 169 : 104 CONTINUE 170 : IRETOU = 0 170 : CALL LIROBJ ('MAILLAGE',I,0,IRETOU) 171 : IF (IRETOU .EQ. 1) THEN 172 : LI2COU = I 173 : ELSE 173 : CALL LIROBJ ('POINT',I,1,IRETOU) 174 : IF (IERR .NE. 0) RETURN 175 : PT2COU = I 176 : END IF 177 : GOTO 200 178 : 105 CONTINUE 178 : CALL LIRREE (BIDSP,1,IRETOU) 179 : IF (IERR .NE. 0) RETURN 180 : U1COU = BIDSP 180 : CALL LIRREE (BIDSP,1,IRETOU) 181 : IF (IERR .NE. 0) RETURN 182 : U2COU = BIDSP 183 : * RQ: AUCUNE RELATION D'ORDRE ENTRE "U1COU" ET "U2COU" POUR 184 : * NE PAS IMPOSER, PAR EXEMPLE, AU POINT INITIAL DE 185 : * CORRESPONDRE AU PLUS PETIT PARAMETRE. 186 : GOTO 200 187 : 106 CONTINUE 188 : REGCOU = .TRUE. 189 : GOTO 200 190 : 200 CONTINUE 191 : * 192 : GOTO 205 193 : * END DO 194 : 206 CONTINUE 195 : * 196 : * -- LECTURE DES POINTS DU POLYNOME -- 197 : * 198 : SEGINI,MTEMP 198 : CALL LIROBJ ('POINT',IP,1,IRETOU) 199 : IF (IERR .NE. 0) RETURN 200 : ITEMP(1) = IP 200 : CALL LIROBJ ('POINT',IP,1,IRETOU) 201 : IF (IERR .NE. 0) RETURN 202 : ITEMP(2) = IP 203 : * DO 204 : 305 CONTINUE 204 : CALL LIROBJ ('POINT',IP,0,IRETOU) 205 : IF (IRETOU .EQ. 1) THEN 206 : ITEMP(**) = IP 207 : ELSE 208 : * --> SORTIE DE BOUCLE 209 : GOTO 306 210 : END IF 211 : GOTO 305 212 : * END DO 213 : 306 CONTINUE 214 : ND1COU = ITEMP(/1) 215 : * 216 : * CREATION DES POLYNOMES REELS: 217 : N = ND1COU 218 : SEGINI,MCOFCO 219 : ICOFCO = MCOFCO 220 : SEGACT,MCOORD 221 : IF (IDIM .EQ. 3) THEN 221 : CALL DCOMP1(ITEMP,N,XCOOR,COFCOU(1,1),COFCOU(1,2),COFCOU(1,3)) 222 : ELSE 222 : CALL DCOMP1(ITEMP,N,XCOOR,COFCOU(1,1),COFCOU(1,2),RBID) 223 : END IF 224 : SEGSUP,MTEMP 225 : SEGDES,MCOFCO 226 : * 226 : CALL COURB1 (MCOURB, LIGNE) 227 : IF (IERR .NE. 0) RETURN 228 : MCOFCO = ICOFCO 229 : SEGSUP,MCOFCO 230 : SEGSUP,MCOURB 231 : * 231 : CALL ECROBJ ('MAILLAGE',LIGNE) 232 : * 233 : END 234 : 235 : 236 :
© Cast3M 2003 - All rights reserved.
Disclaimer