1 : * DEADUTIL PROCEDUR GOUNAND 07/07/05 21:15:22 5784 2 : ************************************************************************ 3 : * NOM : DEADUTIL 4 : * DESCRIPTION : 5 : * 6 : * 7 : * 8 : * LANGAGE : GIBIANE-CAST3M 9 : * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 10 : * mél : gounand@semt2.smts.cea.fr 11 : ********************************************************************** 12 : * VERSION : v1, 05/04/2006, version initiale 13 : * HISTORIQUE : v1, 05/04/2006, création 14 : * HISTORIQUE : 15 : * HISTORIQUE : 16 : ************************************************************************ 17 : * Prière de PRENDRE LE TEMPS de compléter les commentaires 18 : * en cas de modification de ce sous-programme afin de faciliter 19 : * la maintenance ! 20 : ************************************************************************ 21 : * 22 : * 23 : 'DEBPROC' DEADUTIL ; 24 : 'ARGUMENT' motcle*'MOT' ; 25 : * 26 : lmotcle = 'MOTS' 'DIMM' 'TYPM' 'AXI?' 'SPH?' 'QISO' 'QEQU' ; 27 : 'SI' ('NON' ('EXISTE' lmotcle motcle)) ; 28 : cherr = 'CHAINE' 'Keyword ' motcle ' unknown.' ; 29 : 'ERREUR' cherr ; 30 : 'FINSI' ; 31 : * 32 : 'SI' ('EGA' motcle 'AXI?') ; 33 : vmod = 'VALEUR' 'MODE' ; 34 : laxi = ('EGA' vmod 'AXIS') 'OU' ('EGA' vmod 'UNIDAXIS') 35 : 'OU' ('EGA' vmod 'UNIDAXISAXDZ') 'OU' ('EGA' vmod 'UNIDAXISAXCZ') 36 : 'OU' ('EGA' vmod 'UNIDAXISAXGZ') ; 37 : 'RESPRO' laxi ; 38 : 'FINSI' ; 39 : * 40 : 'SI' ('EGA' motcle 'SPH?') ; 41 : vmod = 'VALEUR' 'MODE' ; 42 : lsph = 'EGA' vmod 'UNIDSPHE' ; 43 : 'RESPRO' lsph ; 44 : 'FINSI' ; 45 : * 46 : 'SI' ('EGA' motcle 'DIMM') ; 47 : 'ARGUMENT' mt*'MAILLAGE' ; 48 : tabdim = 'TABLE' ; 49 : tabdim . 0 = 'MOTS' 'POI1' ; 50 : tabdim . 1 = 'MOTS' 'SEG2' 'SEG3' ; 51 : tabdim . 2 = 'MOTS' 'TRI3' 'TRI6' 'TRI7' 'QUA4' 'QUA8' 'QUA9' ; 52 : tabdim . 3 = 'MOTS' 'CUB8' 'CU20' 'PRI6' 'PR15' 'TET4' 'TE10' 53 : 'PYR5' 'PY13' 'CU27' 'PR21' 'TE15' 'PY19' ; 54 : fidim = FAUX ; 55 : dim = -1 ; 56 : lelem = 'ELEM' mt 'TYPE' ; 57 : nelem = 'DIME' lelem ; 58 : 'SI' ('EGA' nelem 0) ; 59 : cherr = 'CHAINE' 'Maillage vide ?' ; 60 : 'ERREUR' cherr ; 61 : 'FINSI' ; 62 : * 63 : 'REPETER' ielem nelem ; 64 : melem = 'EXTRAIRE' lelem &ielem ; 65 : 'REPETER' itdim 4 ; 66 : idim = ('-' &itdim 1) ; 67 : lli = tabdim . idim ; 68 : * id = ISINLIS melem lli ; 69 : * 'SI' ('NEG' id 0) ; 70 : id = 'EXISTE' lli melem ; 71 : 'SI' id ; 72 : 'SI' fidim ; 73 : 'SI' ('NEG' dim idim) ; 74 : cherr = 'CHAINE' 'Composite mesh not allowed' ; 75 : 'ERREUR' cherr ; 76 : 'FINSI' ; 77 : 'SINON' ; 78 : dim = idim ; 79 : fidim = VRAI ; 80 : 'FINSI' ; 81 : 'FINSI' ; 82 : 'FIN' itdim ; 83 : 'FIN' ielem ; 84 : * 85 : 'SI' ('NON' fidim) ; 86 : cherr = 'CHAINE' 'No known elements in this mesh' ; 87 : 'ERREUR' cherr ; 88 : 'FINSI' ; 89 : * 90 : 'RESPRO' dim ; 91 : 'FINSI' ; 92 : * 93 : * 94 : * 95 : 'SI' ('EGA' motcle 'TYPM') ; 96 : 'ARGUMENT' mt*'MAILLAGE' ; 97 : tabtyp = 'TABLE' ; 98 : tabtyp . 1 = 'MOTS' 'SEG2' 'TRI3' 'QUA4' 'CUB8' 'PRI6' 'TET4' 'PYR5' ; 99 : tabtyp . 2 = 'MOTS' 'TRI6' 'QUA8' 'CU20' 'PR15' 'TE10' 'PY13' ; 100 : tabtyp . 3 = 'MOTS' 'SEG3' 'TRI7' 'QUA9' 'CU27' 'PR21' 'TE15' 'PY19' ; 101 : listyp = 'MOTS' 'LINE' 'QUAI' 'QUAF' ; 102 : * 103 : fityp = FAUX ; 104 : typ = -1 ; 105 : lelem = 'ELEM' mt 'TYPE' ; 106 : nelem = 'DIME' lelem ; 107 : 'SI' ('EGA' nelem 0) ; 108 : cherr = 'CHAINE' 'Void mesh ?' ; 109 : 'MESSAGE' cherr ; 110 : 'QUITTER' TYPM ; 111 : 'FINSI' ; 112 : * 113 : 'REPETER' ielem nelem ; 114 : melem = 'EXTRAIRE' lelem &ielem ; 115 : 'REPETER' ittyp 3 ; 116 : ityp = &ittyp ; 117 : lli = tabtyp . ityp ; 118 : * id = ISINLIS melem lli ; 119 : * 'SI' ('NEG' id 0) ; 120 : id = 'EXISTE' lli melem ; 121 : 'SI' id ; 122 : 'SI' fityp ; 123 : 'SI' ('NEG' typ ityp) ; 124 : cherr = 'CHAINE' 'Composite mesh not allowed' ; 125 : 'ERREUR' cherr ; 126 : 'FINSI' ; 127 : 'SINON' ; 128 : typ = ityp ; 129 : fityp = VRAI ; 130 : 'FINSI' ; 131 : 'FINSI' ; 132 : 'FIN' ittyp ; 133 : 'FIN' ielem ; 134 : * 135 : 'SI' ('NON' fityp) ; 136 : cherr = 'CHAINE' 'No known elements in this mesh' ; 137 : 'ERREUR' cherr ; 138 : 'FINSI' ; 139 : * 140 : mtyp = 'EXTRAIRE' listyp typ ; 141 : 'RESPRO' mtyp ; 142 : 'FINSI' ; 143 : * 144 : * QISO PROCEDUR GOUNAND 06/04/06 17:53:15 5371 145 : ************************************************************************ 146 : * NOM : QISO 147 : * DESCRIPTION : Critère de qualité d'un maillage : alignement 148 : * (= isotropie) 149 : * 150 : * 151 : * 152 : * LANGAGE : GIBIANE-CAST3M 153 : * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 154 : * mél : gounand@semt2.smts.cea.fr 155 : ********************************************************************** 156 : * VERSION : v1, 11/05/2007, version initiale 157 : * HISTORIQUE : v1, 11/05/2007, création 158 : * HISTORIQUE : 159 : * HISTORIQUE : 160 : ************************************************************************ 161 : * Prière de PRENDRE LE TEMPS de compléter les commentaires 162 : * en cas de modification de ce sous-programme afin de faciliter 163 : * la maintenance ! 164 : ************************************************************************ 165 : * 166 : * 167 : * 168 : 'SI' ('EGA' motcle 'QISO') ; 169 : * 170 : 'ARGUMENT' _mt*'MAILLAGE' ; 171 : 'ARGUMENT' gdisc*'MOT' ; 172 : 'ARGUMENT' methgau*'MOT' ; 173 : * 174 : idim = 'VALEUR' 'DIME' ; 175 : vdim = DEADUTIL 'DIMM' _mt ; 176 : * 177 : 'ARGUMENT' met/'CHPOINT' ; 178 : lmet = 'EXISTE' met ; 179 : 'SI' lmet ; 180 : 'ARGUMENT' metdisc*'MOT' ; 181 : 'SINON' ; 182 : metdisc = 'CSTE' ; 183 : 'FINSI' ; 184 : * 185 : ncmet = '/' ('*' idim ('+' idim 1)) 2 ; 186 : loi = 'CHAINE' 'QALI' ; 187 : * 188 : * Calcul de la fonctionnelle 189 : * 190 : numop = 1 ; 191 : numvar = 1 ; 192 : numder = vdim ; 193 : numdat = 0 ; 194 : numcof = 0 ; 195 : * 196 : A = ININLIN numop numvar numdat numcof numder ; 197 : A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ; 198 : A . 'VAR' . 1 . 'DISC' = 'CSTE' ; 199 : A . 'VAR' . 1 . 'VALEUR' = 1.D0 ; 200 : * 201 : numvar = 1 ; 202 : numdat = ncmet ; 203 : numcof = 1 ; 204 : B = ININLIN numop numvar numdat numcof numder ; 205 : B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ; 206 : B . 'VAR' . 1 . 'DISC' = 'CSTE' ; 207 : B . 'VAR' . 1 . 'VALEUR' = 1.D0 ; 208 : * 209 : idat = 0 ; 210 : 'REPETER' idi idim ; 211 : nomdat = 'CHAINE' 'G' &idi &idi ; 212 : * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ; 213 : idat = '+' idat 1 ; 214 : B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ; 215 : B . 'DAT' . idat . 'DISC' = metdisc ; 216 : 'SI' lmet ; 217 : B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ; 218 : 'SINON' ; 219 : B . 'DAT' . idat . 'VALEUR' = 1.D0 ; 220 : 'FINSI' ; 221 : 'FIN' idi ; 222 : 'REPETER' idi idim ; 223 : nj = '-' idim &idi ; 224 : * 'MESSAGE' ('CHAINE' 'nj=' nj) ; 225 : 'SI' ('>EG' nj 1) ; 226 : 'REPETER' jdi nj ; 227 : nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ; 228 : * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ; 229 : idat = '+' idat 1 ; 230 : B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ; 231 : B . 'DAT' . idat . 'DISC' = metdisc ; 232 : 'SI' lmet ; 233 : B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ; 234 : 'SINON' ; 235 : B . 'DAT' . idat . 'VALEUR' = 0.D0 ; 236 : 'FINSI' ; 237 : 'FIN' jdi ; 238 : 'FINSI' ; 239 : 'FIN' idi ; 240 : lisdat = 'LECT' 1 'PAS' 1 'NPAS' ('-' numdat 1) ; 241 : * 242 : B . 'COF' . 1 . 'COMPOR' = loi ; 243 : B . 'COF' . 1 . 'LDAT' = lisdat ; 244 : * 245 : A . 1 . 1 . 0 = 'LECT' ; 246 : B . 1 . 1 . 0 = 'LECT' 1 ; 247 : * 248 : vfonc = 'NLIN' gdisc _mt A B 'ERF1' methgau ; 249 : * 250 : 'RESPRO' vfonc ; 251 : 'FINSI' ; 252 : * 253 : * QEQU PROCEDUR GOUNAND 06/04/06 17:53:15 5371 254 : ************************************************************************ 255 : * NOM : QEQU 256 : * DESCRIPTION : Critère de qualité d'un maillage : equidistribution 257 : * 258 : * 259 : * 260 : * LANGAGE : GIBIANE-CAST3M 261 : * AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 262 : * mél : gounand@semt2.smts.cea.fr 263 : ********************************************************************** 264 : * VERSION : v1, 11/05/2007, version initiale 265 : * HISTORIQUE : v1, 11/05/2007, création 266 : * HISTORIQUE : 267 : * HISTORIQUE : 268 : ************************************************************************ 269 : * Prière de PRENDRE LE TEMPS de compléter les commentaires 270 : * en cas de modification de ce sous-programme afin de faciliter 271 : * la maintenance ! 272 : ************************************************************************ 273 : * 274 : * 275 : 'SI' ('EGA' motcle 'QEQU') ; 276 : * 277 : 'ARGUMENT' _mt*'MAILLAGE' ; 278 : 'ARGUMENT' gdisc*'MOT' ; 279 : 'ARGUMENT' methgau*'MOT' ; 280 : * 281 : idim = 'VALEUR' 'DIME' ; 282 : vdim = DEADUTIL 'DIMM' _mt ; 283 : * 284 : 'ARGUMENT' met/'CHPOINT' ; 285 : lmet = 'EXISTE' met ; 286 : 'SI' lmet ; 287 : 'ARGUMENT' metdisc*'MOT' ; 288 : 'SINON' ; 289 : metdisc = 'CSTE' ; 290 : 'FINSI' ; 291 : ncmet = '/' ('*' idim ('+' idim 1)) 2 ; 292 : loi = 'CHAINE' 'QEQU' ; 293 : * 294 : * Calcul de la fonctionnelle 295 : * 296 : numop = 1 ; 297 : numvar = 1 ; 298 : numder = vdim ; 299 : numdat = 0 ; 300 : numcof = 0 ; 301 : * 302 : A = ININLIN numop numvar numdat numcof numder ; 303 : A . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ; 304 : A . 'VAR' . 1 . 'DISC' = 'CSTE' ; 305 : A . 'VAR' . 1 . 'VALEUR' = 1.D0 ; 306 : * 307 : numvar = 1 ; 308 : numdat = ncmet ; 309 : numcof = 1 ; 310 : B = ININLIN numop numvar numdat numcof numder ; 311 : B . 'VAR' . 1 . 'NOMDDL' = 'MOTS' 'DUMM' ; 312 : B . 'VAR' . 1 . 'DISC' = 'CSTE' ; 313 : B . 'VAR' . 1 . 'VALEUR' = 1.D0 ; 314 : * 315 : idat = 0 ; 316 : 'REPETER' idi idim ; 317 : nomdat = 'CHAINE' 'G' &idi &idi ; 318 : * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ; 319 : idat = '+' idat 1 ; 320 : B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ; 321 : B . 'DAT' . idat . 'DISC' = metdisc ; 322 : 'SI' lmet ; 323 : B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ; 324 : 'SINON' ; 325 : B . 'DAT' . idat . 'VALEUR' = 1.D0 ; 326 : 'FINSI' ; 327 : 'FIN' idi ; 328 : 'REPETER' idi idim ; 329 : nj = '-' idim &idi ; 330 : * 'MESSAGE' ('CHAINE' 'nj=' nj) ; 331 : 'SI' ('>EG' nj 1) ; 332 : 'REPETER' jdi nj ; 333 : nomdat = 'CHAINE' 'G' &idi ('+' &idi &jdi) ; 334 : * 'MESSAGE' ('CHAINE' 'nomdat=' nomdat) ; 335 : idat = '+' idat 1 ; 336 : B . 'DAT' . idat . 'NOMDDL' = 'MOTS' nomdat ; 337 : B . 'DAT' . idat . 'DISC' = metdisc ; 338 : 'SI' lmet ; 339 : B . 'DAT' . idat . 'VALEUR' = 'EXCO' nomdat met nomdat ; 340 : 'SINON' ; 341 : B . 'DAT' . idat . 'VALEUR' = 0.D0 ; 342 : 'FINSI' ; 343 : 'FIN' jdi ; 344 : 'FINSI' ; 345 : 'FIN' idi ; 346 : lisdat = 'LECT' 1 'PAS' 1 'NPAS' ('-' numdat 1) ; 347 : * 348 : B . 'COF' . 1 . 'COMPOR' = loi ; 349 : B . 'COF' . 1 . 'LDAT' = lisdat ; 350 : * 351 : A . 1 . 1 . 0 = 'LECT' ; 352 : B . 1 . 1 . 0 = 'LECT' 1 ; 353 : * 354 : vfonci = 'NLIN' gdisc _mt A B 'ERF1' methgau ; 355 : * 356 : rvfonci = 'MAXIMUM' ('RESULT' vfonci) ; 357 : rvelemr = 'FLOTTANT' ('NBEL' _mt) ; 358 : fac = '/' rvelemr rvfonci ; 359 : * 360 : vfonc = '*' vfonci fac ; 361 : * 362 : 'SI' faux ; 363 : rvfonc = 'MAXIMUM' ('RESULT' vfonc) ; 364 : tol = '/' rvelemr 10. ; 365 : test = ('EGA' rvfonc rvelemr tol) ; 366 : 'SI' ('NON' test) ; 367 : 'ERREUR' 5 ; 368 : 'FINSI' ; 369 : 'FINSI' ; 370 : * 371 : 'RESPRO' vfonc ; 372 : * 373 : 'FINSI' ; 374 : * 375 : * End of procedure file DEADUTIL 376 : * 377 : 'FINPROC' ; 378 : 379 : 380 :
© Cast3M 2003 - All rights reserved.
Disclaimer