Download deduadap.procedur

Back to the list

   1 : * DEDUADAP  PROCEDUR  CHAT      12/08/07    21:15:02     7481           
   2 : ************************************************************************
   3 : * NOM         : DEDUADAP
   4 : *
   5 : *    Opérateur DEDU option ADAP
   6 : *    --------------------------
   7 : *    CHPO2 = 'DEDU' 'ADAP' MAIL (CHAM1) (RIG1 (CHPO1)) ;
   8 : *
   9 : *    Objet :
  10 : *    _______
  11 : *
  12 : *    Génère un champ de déplacement permettant de régulariser un 
  13 : *    maillage ou de l'adapter suivant une métrique sans changer
  14 : *    sa topologie.
  15 : *
  16 : *    Commentaire :
  17 : *    _____________
  18 : *
  19 : *    MAIL   : maillage à régulariser ou adapter
  20 : *
  21 : *    CHAM1  : champ par élément aux noeuds donnant une métrique :
  22 : *             tenseur symétrique de composantes G11,G22,G12,...
  23 : *             (par défaut, le tenseur unité)
  24 : *
  25 : *    RIG1   : Conditions sur les déplacements
  26 : *    CHPO1    (par défaut, on bloque les noeuds frontières de MAIL)
  27 : *
  28 : *    CHPO2  : champ de déplacement.
  29 : *
  30 : *    Notes :
  31 : *    _______
  32 : *
  33 : *    L'option 'ADAP' est censée fonctionner sans conditions sur le
  34 : *    maillage. 
  35 : *
  36 : *    Référence principale :
  37 : *    ______________________
  38 : *
  39 : *@Article{huang4,
  40 : *  author =       {Weizhang Huang},
  41 : *  title =        {Variational Mesh Adaptation:
  42 : *                  Isotropy and Equidistribution},
  43 : *  journal =      {JCP},
  44 : *  year =         {2001},
  45 : *  volume =       {174},
  46 : *  pages =     {903-924},
  47 : *  endroit = {Classeur Mesh Movement (VIIIb)}
  48 : *}
  49 : *
  50 : *  Je dois faire également un rapport technique...
  51 : *
  52 : *
  53 : *
  54 : * LANGAGE     : GIBIANE-CAST3M
  55 : * AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  56 : *               mél : gounand@semt2.smts.cea.fr
  57 : **********************************************************************
  58 : * VERSION    : v1, 05/04/2006, version initiale
  59 : * HISTORIQUE : v1, 05/04/2006, création
  60 : * HISTORIQUE : 
  61 : * HISTORIQUE :
  62 : ************************************************************************
  63 : * Prière de PRENDRE LE TEMPS de compléter les commentaires
  64 : * en cas de modification de ce sous-programme afin de faciliter
  65 : * la maintenance !
  66 : ************************************************************************
  67 : *
  68 : *
  69 : 'DEBPROC' DEDUADAP ;
  70 : *
  71 : * Lecture des arguments
  72 : *
  73 : 'ARGUMENT' mail*'MAILLAGE' ;
  74 : *
  75 : 'ARGUMENT' rblo/'RIGIDITE' ;
  76 : lrb = 'EXISTE' rblo ;
  77 : 'SI' lrb ;
  78 :    'ARGUMENT' cblo/'CHPOINT' ;
  79 :    lcb = 'EXISTE' cblo ;
  80 : 'SINON' ;
  81 :    lcb = FAUX ;   
  82 : 'FINSI' ;
  83 : *
  84 : lmotcle = 'MOTS' 'METR' 'DISG' 'THET' 'GAMM' 'NITM' 'ACVG' 'METG'
  85 :    'IDIR' 'TINV' ;
  86 : lchad = FAUX ; lchp = FAUX ;
  87 : ldisg   = FAUX ;
  88 : theta   = 0.2D0 ;
  89 : gamma   = 2.D0 ;
  90 : *theta   = 0.2D0 ;
  91 : *gamma   = 2.D0 ;
  92 : itmax   = 40 ;
  93 : acccvg  = VRAI ;
  94 : lmg = FAUX ;
  95 : lidir = FAUX ;
  96 : ltinv = FAUX ;
  97 : *
  98 : 'REPETER' imotcle 0 ;
  99 :    'ARGUMENT' motcle/'MOT' ;
 100 :    'SI' ('NON' ('EXISTE' motcle)) ;
 101 :       'QUITTER' imotcle ;
 102 :    'FINSI' ;      
 103 :    lmc = 'EXISTE' lmotcle motcle ;
 104 :    'SI' ('NON' lmc) ;
 105 :       cherr = 'CHAINE' 'Motcle ' motcle ' unknown' ;
 106 :       'ERREUR' cherr ;
 107 :    'FINSI' ;
 108 : *   
 109 :    'SI' ('EGA' motcle 'METR') ;
 110 :       'ARGUMENT' chad/'MCHAML' ;
 111 :       lchad = 'EXISTE' chad ;
 112 :       'SI' ('NON' lchad) ;
 113 :          'ARGUMENT' chp/'CHPOINT' ;
 114 :          lchp = 'EXISTE' chp ;
 115 :          'ARGUMENT' metdisc*'MOT' ;
 116 :       'SINON' ;
 117 :          lchp = FAUX ;
 118 :       'FINSI' ;
 119 :    'FINSI' ;
 120 : *
 121 :    'SI' ('EGA' motcle 'DISG') ;
 122 :       'ARGUMENT' gdisc*'MOT' ;
 123 :       ldisg = VRAI ;
 124 :    'FINSI' ;
 125 : *
 126 :    'SI' ('EGA' motcle 'THET') ;
 127 :       'ARGUMENT' theta*'FLOTTANT' ;
 128 :       lok = 'ET' ('>' theta -1.D-8) ('<' theta ('+' 1. 1.D-8)) ;
 129 :       'SI' ('NON' lok) ;
 130 :          cherr = 'CHAINE' 'FLOT1 must be in the range [0..1]' ;
 131 :          'ERREUR' cherr ;
 132 :       'FINSI' ;      
 133 :    'FINSI' ;
 134 : *
 135 :    'SI' ('EGA' motcle 'GAMM') ;
 136 :       'ARGUMENT' gamma*'FLOTTANT' ;
 137 :       lok = ('>' gamma ('-' 1.D0 1.D-8)) ;
 138 :       'SI' ('NON' lok) ;
 139 :          cherr = 'CHAINE' 'FLOT2 must be larger than 1' ;
 140 :          'ERREUR' cherr ;
 141 :       'FINSI' ;      
 142 :    'FINSI' ;
 143 : *
 144 :    'SI' ('EGA' motcle 'NITM') ;
 145 :       'ARGUMENT' itmax*'ENTIER' ;
 146 :       lok = ('>' itmax 0) ;
 147 :       'SI' ('NON' lok) ;
 148 :          cherr = 'CHAINE' 'ENTI1 must be larger than 0' ;
 149 :          'ERREUR' cherr ;
 150 :       'FINSI' ;      
 151 :    'FINSI' ;
 152 : *
 153 :    'SI' ('EGA' motcle 'ACVG') ;
 154 :       'ARGUMENT' acccvg*'LOGIQUE' ;
 155 :    'FINSI' ;
 156 : *   
 157 :    'SI' ('EGA' motcle 'METG') ;
 158 :       'ARGUMENT' methgau*'MOT' ;
 159 :       lmg = VRAI ;
 160 :    'FINSI' ;
 161 : *   
 162 :    'SI' ('EGA' motcle 'IDIR') ;
 163 :       'ARGUMENT' idir*'ENTIER' ;
 164 :       lidir = VRAI ;
 165 :    'FINSI' ;
 166 : *   
 167 :    'SI' ('EGA' motcle 'TINV') ;
 168 :       'ARGUMENT' tinv*'TABLE' ;
 169 :       ltinv = VRAI ;
 170 :    'FINSI' ;
 171 : *
 172 : 'FIN' imotcle ;
 173 : ladap = 'OU' lchad lchp ;      
 174 : *
 175 : 'ARGUMENT' debug/'LOGIQUE' ;
 176 : 'SI' ('NON' ('EXISTE' debug)) ;
 177 :    debug = FAUX ;
 178 : 'FINSI' ;
 179 : *
 180 : * Initialisations
 181 : *
 182 : idim = 'VALEUR' 'DIME' ;
 183 : imod = 'VALEUR' 'MODE' ;
 184 : vdim = DEADUTIL 'DIMM' mail ;
 185 : vtyp = DEADUTIL 'TYPM' mail ;
 186 : laxi = DEADUTIL 'AXI?' ;
 187 : lsph = DEADUTIL 'SPH?' ;
 188 : *
 189 : 'SI' ('OU' ('<' idim 1) ('>' idim 3)) ;
 190 :    'ERREUR' ('CHAINE' 'idim = ' idim ' not implemented') ;
 191 : 'FINSI' ;
 192 : 'SI' ('OU' ('EGA' imod 'AXIS') ('EGA' imod 'UNIDAXIS')) ;
 193 :    'ERREUR' ('CHAINE' 'Axisymetric modes not yet implemented') ;
 194 : 'FINSI' ;    
 195 : 'SI' ('EGA' imod 'FOUR') ;
 196 :    'ERREUR' ('CHAINE' 'Fourier mode not implemented') ;
 197 : 'FINSI' ;    
 198 : 'SI' ('EGA' imod 'SPHE') ;
 199 :    'ERREUR' ('CHAINE' 'Spherical mode not yet implemented') ;
 200 : 'FINSI' ;
 201 : *
 202 : vquaf = ('EGA' vtyp 'QUAF') ;
 203 : 'SI' ('ET' ldisg ('NON' vquaf)) ;
 204 :    cherr = 'CHAINE' 'Loption DISG necessite un maillage de QUAF' ;
 205 :    'ERREUR' cherr ;
 206 : 'FINSI' ;
 207 : 'SI' ('ET' lchp ('NON' vquaf)) ;
 208 :    cherr = 'CHAINE' 'Loption METR+CHPO necessite un maillage de QUAF' ;
 209 :    'ERREUR' cherr ;
 210 : 'FINSI' ;
 211 : * 
 212 : * Paramètres du solveur non-linéaire
 213 : *
 214 : * Evaluation de la matrice tangente 
 215 : *   iktan = 1 : Matrice tangente exact (chère)
 216 : *   iktan = 2 :  " approchée 1 (on néglige les termes extradiagonaux
 217 : *                                    (UX,FY)...)
 218 : *                             (par défaut)
 219 : *   iktan = 3 :  " approchée 2 (on néglige en plus les dérivées
 220 : *                                 extradiagonales (ddxi, ddeta))
 221 : *                             (ne fonctionne pas)
 222 : *
 223 : * Accélération de convergence
 224 : *   acccvg = VRAI : accélération à la PV
 225 : *
 226 : * Période de recalcul de la matrice tangente
 227 : *   rktan = i (toutes les i itérations non-linéaires)
 228 : *
 229 : *   itmax : Nombre maxi d'itérations
 230 : *   rfonc : critère d'arrêt sur la variation de la fonctionnelle
 231 : *   fback : facteur divisif pour la relaxation lors d'un backtracking
 232 : *   nback : nombre maxi de backtracking
 233 : *   fvdet : critère pour le backtracking, variation maxi de la valeur
 234 : *           du jacobien
 235 : 
 236 : iktan = 2 ;
 237 : *!!!iktan = 1 ;
 238 : rktan  = 1 ;
 239 : 'SI' debug ;
 240 :    rfonc = 5.D-8 ;
 241 : 'SINON' ;   
 242 :    rfonc = 5.D-2 ;
 243 : 'FINSI' ;   
 244 : fback = 2.D0 ; fvdet = 4.D0 ;
 245 : nback = 10 ;   damp  = 1.0D0  ;
 246 : *
 247 : * Maillage
 248 : *
 249 : 'SI' vquaf ;
 250 :    _mt = mail ;
 251 : 'SINON' ;   
 252 :    _mt = 'CHANGER' mail 'QUAF' ;
 253 : 'FINSI' ;   
 254 : *
 255 : * Inconnus et discrétisation
 256 : *
 257 : 'SI' ('NON' lmg) ;
 258 :    'SI' ('EGA' vtyp 'LINE') ;
 259 :       methgau = 'GAR1' ;
 260 :    'SINON' ;   
 261 :       methgau = 'GAR2' ;
 262 :    'FINSI' ;
 263 : 'FINSI' ;   
 264 : 'SI' ('NON' ldisg) ;
 265 :    gdisc   = vtyp ;
 266 : 'FINSI' ;   
 267 : *
 268 : 'SI' ('OU' laxi lsph) ;
 269 :    lu = 'MOTS' 'UR' 'UZ' ;
 270 :    lf = 'MOTS' 'FR' 'FZ' ;
 271 : 'SINON' ;   
 272 :    lu = 'MOTS' 'UX' 'UY' 'UZ' ;
 273 :    lf = 'MOTS' 'FX' 'FY' 'FZ' ;
 274 : 'FINSI' ;   
 275 : *
 276 : lextr = 'LECT' 1 'PAS' 1 idim ;
 277 : *
 278 : lpr = 'EXTRAIRE' lu lextr ; ldu = 'EXTRAIRE' lf lextr ;
 279 : *
 280 : * Métrique 
 281 : *
 282 : 'SI' ladap;
 283 :    'SI' lchad ;
 284 : *      $mt = 'MODE' _mt 'NAVIER_STOKES' 'QUAF' ;
 285 : *      chpmet = 'KCHA' $mt chad 'CHPO' 'QUAF' ;     
 286 : *      metdisc = 'CSTE' ;
 287 :       $mt = 'MODELISER' mail 'THERMIQUE' ;
 288 :       chpmet  = 'CHANGER' 'CHPO' $mt chad ;
 289 :       metdisc = gdisc ;
 290 :    'FINSI' ;
 291 :    'SI' lchp ;
 292 :       chpmet = chp ;
 293 :    'FINSI' ;            
 294 : 'FINSI' ;
 295 : *
 296 : * Conditions aux limites sur les déplacements
 297 : *
 298 : 'SI' ('NON' lrb) ;
 299 :    'SI' ('EGA' idim 1) ;
 300 : * Faute de mieux : contour ne fonctionne pas en 1D
 301 :       bord = 'ET' ('POIN' mail 'INITIAL')
 302 :                   ('POIN' mail 'FINAL') ;
 303 :    'FINSI' ;
 304 :    'SI' ('EGA' idim 2) ;
 305 :       bord = 'CONTOUR' mail ;
 306 : *      rblo = 'BLOQUE' 'UX' 'UY' bord ;
 307 :    'FINSI' ;      
 308 :    'SI' ('EGA' idim 3) ;
 309 :       bord = 'ENVELOPPE' mail ;
 310 : *      rblo = 'BLOQUE' 'UX' 'UY' 'UZ' bord ;
 311 :    'FINSI' ;      
 312 :    rblo = 'BLOQUE' 'DEPL' bord ;
 313 : 'FINSI' ;
 314 : *
 315 : * Initilisations diverses
 316 : *
 317 : iniform = 'FORME' ;
 318 : tres = 'TABLE' ;
 319 : dx   = 'MANUEL' 'CHPO' mail lpr ('PROG') ;
 320 : det0 = DEADJACO _mt gdisc methgau ;
 321 : tyde = 'TYPE' det0 ;
 322 : 'SI' ('EGA' tyde 'ENTIER') ;
 323 :    chinfo = 'CHAINE' 'DEDUADAP : the mesh is already skew !' ;
 324 :    'MESSAGE' chinfo ;
 325 :    cherr = 'CHAINE' 'Check the input mesh' ;
 326 :    'ERREUR' cherr ;
 327 : 'FINSI' ;
 328 : 'SI' ladap ;
 329 :    fonc0 = DEADFONC _mt gdisc methgau theta gamma
 330 :                     chpmet metdisc 'ELEM' ;
 331 :    'SI' lidir ;
 332 :       res   = DEADRESI _mt gdisc methgau theta gamma ldu
 333 :          chpmet metdisc idir ;
 334 :    'SINON' ;
 335 :       res   = DEADRESI _mt gdisc methgau theta gamma ldu
 336 :          chpmet metdisc ;
 337 :    'FINSI' ;
 338 : 'SINON' ;   
 339 :    fonc0 = DEADFONC _mt gdisc methgau theta gamma 'ELEM' ;
 340 :    'SI' lidir ;
 341 :       res   = DEADRESI _mt gdisc methgau theta gamma ldu idir ;
 342 :    'SINON' ;
 343 :       res   = DEADRESI _mt gdisc methgau theta gamma ldu ;
 344 :    'FINSI' ;
 345 : 'FINSI' ;   
 346 : dampi = damp ;
 347 : fonci = fonc0 ;
 348 : deti  = det0 ;
 349 : 'SI' acccvg ;
 350 :    znacce = 3 ; itdep = 3 ;
 351 :    acfp1  =  'COPIER' ('*' res 0.) ;  acfp2  = acfp1 ;
 352 :    acfp3  = acfp1 ;  acfep1 = acfp1;
 353 :    acfep2 = acfp1 ;  correc=0.; freap = 0. ;
 354 : 'FINSI' ;   
 355 : *
 356 : * Algorithme non linéaire
 357 : *
 358 : cvgok = FAUX ;
 359 : 'REPETER' it itmax ;
 360 :    dampi = 'MINIMUM' ('PROG' damp ('*' dampi fback)) ;
 361 :    'SI' debug ;
 362 :       ch = 'CHAINE' '  Itération : ' &it ;
 363 :       'MESSAGE' ch ;
 364 :       ch = 'CHAINE' '    dampi=' dampi ;
 365 :       'MESSAGE' ch ;
 366 :    'FINSI' ;      
 367 : *
 368 : *  Calcul du résidu
 369 : *
 370 : *    partie liée à la fonctionnelle
 371 :    'SI' ladap ;
 372 :       'SI' lidir ;
 373 :          resf = DEADRESI _mt gdisc methgau theta gamma ldu
 374 :             chpmet metdisc idir ;
 375 :       'SINON' ;
 376 :          resf = DEADRESI _mt gdisc methgau theta gamma ldu
 377 :             chpmet metdisc ;
 378 :       'FINSI' ;            
 379 :    'SINON' ;
 380 :       'SI' lidir ;
 381 :          resf = DEADRESI _mt gdisc methgau theta gamma ldu idir ;
 382 :       'SINON' ;
 383 :          resf = DEADRESI _mt gdisc methgau theta gamma ldu ;
 384 :       'FINSI' ;
 385 :    'FINSI' ;      
 386 : *    partie liée aux blocages
 387 :    resb = '*' rblo dx ;
 388 :    'SI' lcb ;
 389 :       resb = resb '-' cblo ;
 390 :    'FINSI' ;
 391 :    res = resf '+' resb ;
 392 : *  acceleration de convergence
 393 :    'SI' acccvg ;
 394 :       correcp = correc; correc = 0;
 395 :       acfp0 = 'ENLEVER' (res - freap) 'FLX' ;
 396 :       acfep0 = acfp0;
 397 :       acfep0 = acfep0 - correcp ;
 398 :       'SI' ('MULT'  &it znacce)   ;
 399 :          'SI' ('>' &it itdep) ;
 400 :             'SI' ('>' dampi ('*' damp 0.9)) ;
 401 :                'SI' debug ;
 402 :                   'MESSAGE' 'Convergence acceleration' ;
 403 :                'FINSI' ;                  
 404 :                 correc = act3  acfep2  acfep1 acfep0                    
 405 :                               acfp3 acfp2 acfp1  acfp0 ;
 406 :                res = '-' res correc;
 407 :             'FINSI' ;                  
 408 :          'FINSI' ;
 409 :       'FINSI' ;      
 410 :       'SI' ('>' &it 3) ;
 411 :          'DETRUIT' acfp3 ;
 412 :          'DETRUIT' acfep2 ;
 413 :       'FINSI' ;   
 414 :       acfp3  = acfp2  ; acfp2  = acfp1  ; acfp1  = acfp0 ;
 415 :       acfep2 = acfep1 ; acfep1 = acfep0 ;
 416 :       'MENAGE' ;
 417 :    'FINSI' ;
 418 : *
 419 : *  Calcul de la matrice tangente
 420 : *
 421 :    'SI' ('MULT' ('-' &it 1) rktan) ;
 422 :       'SI' ladap ;
 423 :          'SI' lidir ;
 424 :             jac  = DEADKTAN _mt gdisc methgau theta gamma
 425 :                             lpr ldu chpmet metdisc iktan idir ;
 426 :          'SINON' ;
 427 :             jac  = DEADKTAN _mt gdisc methgau theta gamma
 428 :                             lpr ldu iktan chpmet metdisc ;
 429 :          'FINSI' ;                            
 430 :       'SINON' ;
 431 :          'SI' lidir ;
 432 :             jac  = DEADKTAN _mt gdisc methgau theta gamma
 433 :                             lpr ldu iktan idir ;
 434 :          'SINON' ;
 435 :             jac  = DEADKTAN _mt gdisc methgau theta gamma
 436 :                             lpr ldu iktan ;
 437 :          'FINSI' ;                            
 438 :       'FINSI' ;         
 439 :       jact = 'ET' jac rblo ;
 440 :    'FINSI' ;
 441 : *
 442 : * Résolution du problème linéarisé
 443 : *   
 444 :    'SI' ltinv ;
 445 :       mat smb = jact ('*' -1.D0 res) ;
 446 :       'SI' ('EGA' (tinv . 'TYPINV') 0) ;
 447 :          'OPTI' impi 0 ;
 448 :          sol = 'RESOUD' mat smb 'NOID' ;
 449 :          'OPTI' impi 0 ;
 450 :       'SINON' ;
 451 :          'SI' ('EXISTE' tinv 'LTIME') ;
 452 :             ltime = tinv . 'LTIME' ;
 453 :          'SINON' ;
 454 :             ltime = FAUX ;
 455 :          'FINSI' ;          
 456 : *
 457 :          'SI' ('EGA' ltime vrai) ;
 458 :             sol tt  = 'KRES' mat smb 'TYPI' tinv ;
 459 :             'LISTE' tt ;
 460 :          'SINON' ;              
 461 :             sol  = 'KRES' mat smb 'TYPI' tinv ;
 462 :          'FINSI' ;
 463 :       'FINSI' ;      
 464 :       ddx   = sol ;
 465 :    'SINON' ;
 466 :       ddx   = 'RESO' jact ('*' -1.D0 res) ;
 467 :    'FINSI' ;      
 468 : *   'LISTE' ddx ;
 469 : *
 470 : * 
 471 : *
 472 :    'SI' acccvg ;
 473 :       freap = reac rblo ddx ;
 474 : *   resx  = 'ENLEVER' ('-' res (reac rblo ddx)) 'FLX' ;
 475 : *   resx2  = 'ENLEVER' (res) 'FLX' ;
 476 :    'FINSI' ;
 477 : *
 478 : * Backtracking
 479 : *
 480 :    backok = FAUX ;
 481 :    'REPETER' iback nback ;
 482 :      'SI' ('>' &iback 1) ;
 483 :         dampi = '/' dampi fback ;
 484 :         'SI' debug ;
 485 :            ch = 'CHAINE' '    dampi=' dampi ;
 486 :            'MESSAGE' ch ;
 487 :          'FINSI' ;           
 488 :       'FINSI' ;
 489 :       ddxi = '*' ddx dampi ;
 490 :       depx = 'EXCO' lpr ddxi lpr 'NOID' ;
 491 : * Test si le déplacement calculé inverse un jacobien
 492 : * ou le change trop
 493 :       oldconf = 'FORME' ;
 494 :       'FORME' depx ;
 495 :       detip = DEADJACO _mt gdisc methgau ;
 496 :       'FORME' oldconf ;
 497 :       tyde = 'TYPE' detip ;
 498 :       'SI' ('EGA' tyde 'ENTIER') ;
 499 :          'SI' debug ;
 500 :             ch = 'CHAINE' '    Warning : inv. loc. jacobien !' ;
 501 :             'MESSAGE' ch ;
 502 :          'FINSI' ;            
 503 :       'SINON' ;         
 504 :          vardet = ('/' detip deti) ;
 505 :          mivd = 'MINIMUM' vardet ;
 506 :          mavd = 'MAXIMUM' vardet ;
 507 :          'SI' debug ;
 508 :             'MESSAGE' ('CHAINE' 'Mini var jaco = ' mivd ) ;
 509 :             'MESSAGE' ('CHAINE' 'Maxi var jaco = ' mavd ) ;
 510 :          'FINSI' ;            
 511 :          bigvar = 'OU' ('>' mavd fvdet) ('<' mivd ('/' 1.D0 fvdet)) ;
 512 :          'SI' bigvar ;
 513 :             'SI' debug ;
 514 :                ch = 'CHAINE'
 515 :                '    Warn : trop grande variation du jaco !' ;
 516 :                'MESSAGE' ch ;
 517 :             'FINSI' ;                     
 518 :          'SINON' ;            
 519 :             backok = VRAI ;
 520 :             'QUITTER' iback ;
 521 :          'FINSI' ;                     
 522 :       'FINSI' ;         
 523 :    'FIN' iback ;
 524 :    'SI' ('NON' backok) ;
 525 :       chinfo1 = 'CHAINE'
 526 :             'DEDUADAP : Backtracking failed to converge !' ;
 527 :       'MESSAGE' chinfo1 ;
 528 :       chinfo2 = 'CHAINE' 'Please check the output displacement'
 529 :       'MESSAGE' chinfo2 ;
 530 :       dep = 'EXCO' lpr dx lpr ;
 531 :       'RESPRO' dep ;
 532 :       'QUITTER' DEDUADAP ;
 533 :    'FINSI' ;
 534 :    dx = '+' dx ddxi ;
 535 :    'FORME' depx ;
 536 :    'SI' ladap ;
 537 :       foncip = DEADFONC _mt gdisc methgau theta gamma
 538 :                         chpmet metdisc 'ELEM' ;
 539 :    'SINON' ;      
 540 :       foncip = DEADFONC _mt gdisc methgau theta gamma 'ELEM' ;
 541 :    'FINSI' ;      
 542 : *
 543 : * Critère de convergence
 544 : *
 545 :    vrrfon = '/' ('-' foncip fonci) fonci ;
 546 :    critconv = 'MAXIMUM' vrrfon 'ABS' ;
 547 :    tres . &it = critconv ;
 548 :    cvgok = ('<' critconv rfonc) ;
 549 :    'SI' debug ;
 550 :       chmess = 'CHAINE' '  critere    = ' critconv ;
 551 :       'MESSAGE' chmess ;
 552 :    'FINSI' ;
 553 :    deti = detip ;
 554 :    fonci = foncip ;
 555 :    'SI' debug ;
 556 :       tit   = 'CHAINE' 'Maillage ; it=' &it ' crit=' critconv ;
 557 :       TRAC 'CACH' mail 'TITR' tit 'NCLK' ;
 558 :    'FINSI' ;      
 559 :    'SI' cvgok ;
 560 :       'QUITTER' it ;
 561 :    'FINSI' ;
 562 : 'FIN' it ;   
 563 : 'FORME' iniform ;
 564 : dep = 'EXCO' lpr dx lpr ;
 565 : *
 566 : itfin = ('-' &it 1) ;
 567 : 'SI' debug ;
 568 :    ch = 'CHAINE' '  Itération finale : ' itfin ;
 569 :    'MESSAGE' ch ;
 570 :    lit = 'PROG' 1. 'PAS' 1. 'NPAS' ('-' itfin 1) ;
 571 :    lres = 'PROG' ;
 572 :    'REPETER' it itfin ;
 573 :       lres = 'ET' lres ('PROG'
 574 :          ('/' ('LOG' ('+' (tres . &it ) 1.D-16))
 575 :               ('LOG' 10.D0) )) ;
 576 :    'FIN' it ;
 577 :    titev = 'CHAINE' 'LOG10 Critere (iterations)' ;
 578 :    evres = 'EVOL' 'MANU' lit lres 'TITR' titev ;
 579 :    'DESSIN' evres ;
 580 : 'FINSI' ;
 581 : *
 582 : 'RESPRO' dep ;
 583 : *
 584 : * End of procedure file DEDUADAP
 585 : *
 586 : 'FINPROC' ;
 587 : 
 588 :  
 589 :  
 590 :  
 591 :  
 592 :  

© Cast3M 2003 - All rights reserved.
Disclaimer