Télécharger la plaquette Cast3M


fr en

Télécharger deduadap.procedur

Retour à la liste

Numérotation des lignes : 

  1. * DEDUADAP  PROCEDUR  PASCAL    21/03/19    21:15:01     10924          
  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' 'DENS' ;
  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 ;
  99.    'ARGUMENT' motcle/'MOT' ;
  100.    'SI' ('NON' ('EXISTE' motcle)) ;
  101.       'QUITTER' imotcle ;
  102.    'FINSI' ;      
  103.    lmc = 'EXISTE' lmotcle motcle ;
  104.    'SI' ('NON' lmc) ;
  105. *1052 2
  106. *Mot-cle incorrect "%M1:4". Voici la liste des valeurs admises : %M5:40
  107.       'ERRE' 1052 'AVEC' ('CHAI' motcle
  108. 'METR DISG THET GAMM NITM ACVG METG IDIR TINV') ;
  109.    'FINSI' ;
  110. *   
  111.    'SI' ('EGA' motcle 'METR') ;
  112.       'ARGUMENT' chad/'MCHAML' ;
  113.       lchad = 'EXISTE' chad ;
  114.       'SI' ('NON' lchad) ;
  115.          'ARGUMENT' chp/'CHPOINT' ;
  116.          lchp = 'EXISTE' chp ;
  117.          'ARGUMENT' metdisc*'MOT' ;
  118.       'SINON' ;
  119.          argu kmodl1*'MMODEL' ;
  120.          lchp = FAUX ;
  121.       'FINSI' ;
  122.    'SINON' ;
  123.      'SI' ('EGA' motcle 'DENS') ;
  124.        'ARGUMENT' chp*'CHPOINT' ;
  125.        chp    = 'REDU' chp mail ;
  126.        kmodl1 = 'MODE' mail 'THERMIQUE' ;
  127.        chad   = 'CHAN' 'CHAM' kmodl1 chp ;
  128.        chad   = (chad ** -2) 'NOMC' 'G11' ;
  129.        'SI' (('VALE' DIME) '>' 1) ;
  130.          chad0  = 0.*chad ;
  131.          chad   = chad 'ET' (chad 'NOMC' 'G22') 'ET' (chad0 'NOMC' 'G21') ;
  132.        'FINS' ;
  133.        'SI' (('VALE' DIME) '>' 2) ;
  134.          chad   = chad 'ET' (chad 'NOMC' 'G33') 'ET' (chad0 'NOMC' 'G31') 'ET' (chad0 'NOMC' 'G32') ;
  135.        'FINS' ;
  136.        lchad  = VRAI ;
  137.        lchp   = FAUX ;
  138.      'FINSI' ;
  139.    'FINSI' ;
  140. *
  141.    'SI' ('EGA' motcle 'DISG') ;
  142.       'ARGUMENT' gdisc*'MOT' ;
  143.       ldisg = VRAI ;
  144.    'FINSI' ;
  145. *
  146.    vprec = ('VALE' 'PREC') '**' 0.75 ;
  147.    mvprec = '*' vprec -1. ;
  148.    'SI' ('EGA' motcle 'THET') ;
  149.       'ARGUMENT' theta*'FLOTTANT' ;
  150.       lok = 'ET' ('>' theta mvprec) ('<' theta ('+' 1. vprec)) ;
  151.       'SI' ('NON' lok) ;
  152. *  42 2   %m1:8 = %r1 non compris entre %r2 et %r3
  153.          'ERRE' 42 'AVEC' 'FLOT1' ('PROG' theta 0. 1.) ;
  154.       'FINSI' ;      
  155.    'FINSI' ;
  156. *
  157.    'SI' ('EGA' motcle 'GAMM') ;
  158.       'ARGUMENT' gamma*'FLOTTANT' ;
  159.       lok = ('>' gamma ('-' 1.D0 vprec)) ;
  160.       'SI' ('NON' lok) ;
  161. *  41 2 %m1:8 = %r1 inferieur a %r2
  162.          'ERRE' 41 'AVEC' 'FLOT2' ('PROG' gamma 1.) ;
  163.       'FINSI' ;      
  164.    'FINSI' ;
  165. *
  166.    'SI' ('EGA' motcle 'NITM') ;
  167.       'ARGUMENT' itmax*'ENTIER' ;
  168.       lok = ('>' itmax 0) ;
  169.       'SI' ('NON' lok) ;
  170. *  41 2 %m1:8 = %r1 inferieur a %r2
  171.          'ERRE' 41 'AVEC' 'ENTI1' ('PROG' itmax 1.) ;
  172.       'FINSI' ;      
  173.    'FINSI' ;
  174. *
  175.    'SI' ('EGA' motcle 'ACVG') ;
  176.       'ARGUMENT' acccvg*'LOGIQUE' ;
  177.    'FINSI' ;
  178. *   
  179.    'SI' ('EGA' motcle 'METG') ;
  180.       'ARGUMENT' methgau*'MOT' ;
  181.       lmg = VRAI ;
  182.    'FINSI' ;
  183. *   
  184.    'SI' ('EGA' motcle 'IDIR') ;
  185.       'ARGUMENT' idir*'ENTIER' ;
  186.       lidir = VRAI ;
  187.    'FINSI' ;
  188. *   
  189.    'SI' ('EGA' motcle 'TINV') ;
  190.       'ARGUMENT' tinv*'TABLE' ;
  191.       ltinv = VRAI ;
  192.    'FINSI' ;
  193. *
  194. 'FIN' imotcle ;
  195. ladap = 'OU' lchad lchp ;      
  196. *
  197. 'ARGUMENT' debug/'LOGIQUE' ;
  198. 'SI' ('NON' ('EXISTE' debug)) ;
  199.    debug = FAUX ;
  200. 'FINSI' ;
  201. *
  202. * Initialisations
  203. *
  204. idim = 'VALEUR' 'DIME' ;
  205. imod = 'VALEUR' 'MODE' ;
  206. vdim = DEADUTIL 'DIMM' mail ;
  207. vtyp = DEADUTIL 'TYPM' mail ;
  208. laxi = DEADUTIL 'AXI?' ;
  209. lsph = DEADUTIL 'SPH?' ;
  210. *
  211. 'SI' ('OU' ('<' idim 1) ('>' idim 3)) ;
  212. * 709 2 Fonction indisponible en dimension %i1.
  213.    'ERREUR' 709 'AVEC' idim ;
  214. 'FINSI' ;
  215. 'SI' (('EGA' imod 'AXIS') 'OU' ('EGA' imod 'UNIDAXIS') 'OU'
  216.    ('EGA' imod 'FOUR') 'OU' ('EGA' imod 'SPHE')) ;
  217. *-105 0 Mode de calcul actuel %m1:32
  218.    'ERRE'  -105 'AVEC' imod ;
  219. * 710 2 Fonction indisponible pour ce mode de calcul
  220.    'ERRE' 710 ;
  221. 'FINSI' ;
  222. *
  223. vquaf = ('EGA' vtyp 'QUAF') ;
  224. 'SI' ('ET' ldisg ('NON' vquaf)) ;
  225.    'MESS' 'DISG option :' ;
  226. *  66 2 L'objet %m1:8 doit etre de type %m9:16
  227.    'ERRE' 66 'AVEC' 'MAIL    QUAF' ;
  228. 'FINSI' ;
  229. 'SI' ('ET' lchp ('NON' vquaf)) ;
  230.    'MESS' 'METR+CHPO option :' ;
  231. *  66 2 L'objet %m1:8 doit etre de type %m9:16
  232.    'ERRE' 66 'AVEC' 'MAIL    QUAF' ;
  233. 'FINSI' ;
  234. * 
  235. * Paramètres du solveur non-linéaire
  236. *
  237. * Evaluation de la matrice tangente 
  238. *   iktan = 1 : Matrice tangente exact (chère)
  239. *   iktan = 2 :  " approchée 1 (on néglige les termes extradiagonaux
  240. *                                    (UX,FY)...)
  241. *                             (par défaut)
  242. *   iktan = 3 :  " approchée 2 (on néglige en plus les dérivées
  243. *                                 extradiagonales (ddxi, ddeta))
  244. *                             (ne fonctionne pas)
  245. *
  246. * Accélération de convergence
  247. *   acccvg = VRAI : accélération à la PV
  248. *
  249. * Période de recalcul de la matrice tangente
  250. *   rktan = i (toutes les i itérations non-linéaires)
  251. *
  252. *   itmax : Nombre maxi d'itérations
  253. *   rfonc : critère d'arrêt sur la variation de la fonctionnelle
  254. *   fback : facteur divisif pour la relaxation lors d'un backtracking
  255. *   nback : nombre maxi de backtracking
  256. *   fvdet : critère pour le backtracking, variation maxi de la valeur
  257. *           du jacobien
  258.  
  259. iktan = 2 ;
  260. *!!!iktan = 1 ;
  261. rktan  = 1 ;
  262. 'SI' debug ;
  263.    rfonc = 5.D-8 ;
  264. 'SINON' ;   
  265.    rfonc = 5.D-2 ;
  266. 'FINSI' ;   
  267. fback = 2.D0 ; fvdet = 4.D0 ;
  268. nback = 10 ;   damp  = 1.0D0  ;
  269. *
  270. * Maillage
  271. *
  272. 'SI' vquaf ;
  273.    _mt = mail ;
  274. 'SINON' ;   
  275.    _mt = 'CHANGER' mail 'QUAF' ;
  276. 'FINSI' ;   
  277. *
  278. * Inconnus et discrétisation
  279. *
  280. 'SI' ('NON' lmg) ;
  281.    'SI' ('EGA' vtyp 'LINE') ;
  282.       methgau = 'GAR1' ;
  283.    'SINON' ;   
  284.       methgau = 'GAR2' ;
  285.    'FINSI' ;
  286. 'FINSI' ;   
  287. 'SI' ('NON' ldisg) ;
  288.    gdisc   = vtyp ;
  289. 'FINSI' ;   
  290. *
  291. 'SI' ('OU' laxi lsph) ;
  292.    lu = 'MOTS' 'UR' 'UZ' ;
  293.    lf = 'MOTS' 'FR' 'FZ' ;
  294. 'SINON' ;   
  295.    lu = 'MOTS' 'UX' 'UY' 'UZ' ;
  296.    lf = 'MOTS' 'FX' 'FY' 'FZ' ;
  297. 'FINSI' ;   
  298. *
  299. lextr = 'LECT' 1 'PAS' 1 idim ;
  300. *
  301. lpr = 'EXTRAIRE' lu lextr ; ldu = 'EXTRAIRE' lf lextr ;
  302. *
  303. * Métrique 
  304. *
  305. 'SI' ladap;
  306.    'SI' lchad ;
  307. *      $mt = 'MODE' _mt 'NAVIER_STOKES' 'QUAF' ;
  308. *      chpmet = 'KCHA' $mt chad 'CHPO' 'QUAF' ;     
  309. *      metdisc = 'CSTE' ;
  310. *      $mt = 'MODELISER' mail 'THERMIQUE' ;
  311.       chpmet  = 'CHANGER' 'CHPO' kmodl1 chad ;
  312.       metdisc = gdisc ;
  313.    'FINSI' ;
  314.    'SI' lchp ;
  315.       chpmet = chp ;
  316.    'FINSI' ;            
  317. 'FINSI' ;
  318. *
  319. * Conditions aux limites sur les déplacements
  320. *
  321. 'SI' ('NON' lrb) ;
  322.    'SI' ('EGA' idim 1) ;
  323. * Faute de mieux : contour ne fonctionne pas en 1D
  324.       bord = 'ET' ('POIN' mail 'INITIAL')
  325.                   ('POIN' mail 'FINAL') ;
  326.    'FINSI' ;
  327.    'SI' ('EGA' idim 2) ;
  328.       bord = 'CONTOUR' mail ;
  329. *      rblo = 'BLOQUE' 'UX' 'UY' bord ;
  330.    'FINSI' ;      
  331.    'SI' ('EGA' idim 3) ;
  332.       bord = 'ENVELOPPE' mail ;
  333. *      rblo = 'BLOQUE' 'UX' 'UY' 'UZ' bord ;
  334.    'FINSI' ;      
  335.    rblo = 'BLOQUE' 'DEPL' bord ;
  336. 'FINSI' ;
  337. *
  338. * Initilisations diverses
  339. *
  340. iniform = 'FORME' ;
  341. tres = 'TABLE' ;
  342. dx   = 'MANUEL' 'CHPO' mail lpr ('PROG') ;
  343. det0 = DEADJACO _mt gdisc methgau ;
  344. tyde = 'TYPE' det0 ;
  345. 'SI' ('EGA' tyde 'ENTIER') ;
  346.    chinfo = 'CHAINE' 'DEDUADAP : the mesh is already skew !' ;
  347.    'MESSAGE' chinfo ;
  348. * 426 2 Maillage incorrect
  349.    'ERRE' 426 ;
  350. 'FINSI' ;
  351. 'SI' ladap ;
  352.    fonc0 = DEADFONC _mt gdisc methgau theta gamma
  353.                     chpmet metdisc 'ELEM' ;
  354.    'SI' lidir ;
  355.       res   = DEADRESI _mt gdisc methgau theta gamma ldu
  356.          chpmet metdisc idir ;
  357.    'SINON' ;
  358.       res   = DEADRESI _mt gdisc methgau theta gamma ldu
  359.          chpmet metdisc ;
  360.    'FINSI' ;
  361. 'SINON' ;   
  362.    fonc0 = DEADFONC _mt gdisc methgau theta gamma 'ELEM' ;
  363.    'SI' lidir ;
  364.       res   = DEADRESI _mt gdisc methgau theta gamma ldu idir ;
  365.    'SINON' ;
  366.       res   = DEADRESI _mt gdisc methgau theta gamma ldu ;
  367.    'FINSI' ;
  368. 'FINSI' ;   
  369. dampi = damp ;
  370. fonci = fonc0 ;
  371. deti  = det0 ;
  372. 'SI' acccvg ;
  373.    znacce = 3 ; itdep = 3 ;
  374.    acfp1  =  'COPIER' ('*' res 0.) ;  acfp2  = acfp1 ;
  375.    acfp3  = acfp1 ;  acfep1 = acfp1;
  376.    acfep2 = acfp1 ;  correc=0.; freap = 0. ;
  377. 'FINSI' ;   
  378. *
  379. * Algorithme non linéaire
  380. *
  381. cvgok = FAUX ;
  382. 'REPETER' it itmax ;
  383.    dampi = 'MINIMUM' ('PROG' damp ('*' dampi fback)) ;
  384.    'SI' debug ;
  385.       ch = 'CHAINE' '  Itération : ' &it ;
  386.       'MESSAGE' ch ;
  387.       ch = 'CHAINE' '    dampi=' dampi ;
  388.       'MESSAGE' ch ;
  389.    'FINSI' ;      
  390. *
  391. *  Calcul du résidu
  392. *
  393. *    partie liée à la fonctionnelle
  394.    'SI' ladap ;
  395.       'SI' lidir ;
  396.          resf = DEADRESI _mt gdisc methgau theta gamma ldu
  397.             chpmet metdisc idir ;
  398.       'SINON' ;
  399.          resf = DEADRESI _mt gdisc methgau theta gamma ldu
  400.             chpmet metdisc ;
  401.       'FINSI' ;            
  402.    'SINON' ;
  403.       'SI' lidir ;
  404.          resf = DEADRESI _mt gdisc methgau theta gamma ldu idir ;
  405.       'SINON' ;
  406.          resf = DEADRESI _mt gdisc methgau theta gamma ldu ;
  407.       'FINSI' ;
  408.    'FINSI' ;      
  409. *    partie liée aux blocages
  410.    resb = '*' rblo dx ;
  411.    'SI' lcb ;
  412.       resb = resb '-' cblo ;
  413.    'FINSI' ;
  414.    res = resf '+' resb ;
  415. *  acceleration de convergence
  416.    'SI' acccvg ;
  417.       correcp = correc; correc = 0;
  418.       acfp0 = 'ENLEVER' (res - freap) 'FLX' ;
  419.       acfep0 = acfp0;
  420.       acfep0 = acfep0 - correcp ;
  421.       'SI' ('MULT'  &it znacce)   ;
  422.          'SI' ('>' &it itdep) ;
  423.             'SI' ('>' dampi ('*' damp 0.9)) ;
  424.                'SI' debug ;
  425.                   'MESSAGE' 'Convergence acceleration' ;
  426.                'FINSI' ;                  
  427.                 correc = act3  acfep2  acfep1 acfep0                    
  428.                               acfp3 acfp2 acfp1  acfp0 ;
  429.                res = '-' res correc;
  430.             'FINSI' ;                  
  431.          'FINSI' ;
  432.       'FINSI' ;      
  433.       'SI' ('>' &it 3) ;
  434.          'DETRUIT' acfp3 ;
  435.          'DETRUIT' acfep2 ;
  436.       'FINSI' ;   
  437.       acfp3  = acfp2  ; acfp2  = acfp1  ; acfp1  = acfp0 ;
  438.       acfep2 = acfep1 ; acfep1 = acfep0 ;
  439.       'MENAGE' ;
  440.    'FINSI' ;
  441. *
  442. *  Calcul de la matrice tangente
  443. *
  444.    'SI' ('MULT' ('-' &it 1) rktan) ;
  445.       'SI' ladap ;
  446.          'SI' lidir ;
  447.             jac  = DEADKTAN _mt gdisc methgau theta gamma
  448.                             lpr ldu chpmet metdisc iktan idir ;
  449.          'SINON' ;
  450.             jac  = DEADKTAN _mt gdisc methgau theta gamma
  451.                             lpr ldu iktan chpmet metdisc ;
  452.          'FINSI' ;                            
  453.       'SINON' ;
  454.          'SI' lidir ;
  455.             jac  = DEADKTAN _mt gdisc methgau theta gamma
  456.                             lpr ldu iktan idir ;
  457.          'SINON' ;
  458.             jac  = DEADKTAN _mt gdisc methgau theta gamma
  459.                             lpr ldu iktan ;
  460.          'FINSI' ;                            
  461.       'FINSI' ;         
  462.       jact = 'ET' jac rblo ;
  463.    'FINSI' ;
  464. *
  465. * Résolution du problème linéarisé
  466. *   
  467.    'SI' ltinv ;
  468.       mat smb = jact ('*' -1.D0 res) ;
  469.       'SI' ('EGA' (tinv . 'TYPINV') 0) ;
  470.          'OPTI' impi 0 ;
  471.          sol = 'RESOUD' mat smb 'NOID' ;
  472.          'OPTI' impi 0 ;
  473.       'SINON' ;
  474.          'SI' ('EXISTE' tinv 'LTIME') ;
  475.             ltime = tinv . 'LTIME' ;
  476.          'SINON' ;
  477.             ltime = FAUX ;
  478.          'FINSI' ;          
  479. *
  480.          'SI' ('EGA' ltime vrai) ;
  481.             sol tt  = 'KRES' mat smb 'TYPI' tinv ;
  482.             'LISTE' tt ;
  483.          'SINON' ;              
  484.             sol  = 'KRES' mat smb 'TYPI' tinv ;
  485.          'FINSI' ;
  486.       'FINSI' ;      
  487.       ddx   = sol ;
  488.    'SINON' ;
  489.       ddx   = 'RESO' jact ('*' -1.D0 res) ;
  490.    'FINSI' ;      
  491. *   'LISTE' ddx ;
  492. *
  493. * 
  494. *
  495.    'SI' acccvg ;
  496.       freap = reac rblo ddx ;
  497. *   resx  = 'ENLEVER' ('-' res (reac rblo ddx)) 'FLX' ;
  498. *   resx2  = 'ENLEVER' (res) 'FLX' ;
  499.    'FINSI' ;
  500. *
  501. * Backtracking
  502. *
  503.    backok = FAUX ;
  504.    'REPETER' iback nback ;
  505.      'SI' ('>' &iback 1) ;
  506.         dampi = '/' dampi fback ;
  507.         'SI' debug ;
  508.            ch = 'CHAINE' '    dampi=' dampi ;
  509.            'MESSAGE' ch ;
  510.          'FINSI' ;           
  511.       'FINSI' ;
  512.       ddxi = '*' ddx dampi ;
  513.       depx = 'EXCO' lpr ddxi lpr 'NOID' ;
  514. * Test si le déplacement calculé inverse un jacobien
  515. * ou le change trop
  516.       oldconf = 'FORME' ;
  517.       'FORME' depx ;
  518.       detip = DEADJACO _mt gdisc methgau ;
  519.       'FORME' oldconf ;
  520.       tyde = 'TYPE' detip ;
  521.       'SI' ('EGA' tyde 'ENTIER') ;
  522.          'SI' debug ;
  523.             ch = 'CHAINE' '    Warning : inv. loc. jacobien !' ;
  524.             'MESSAGE' ch ;
  525.          'FINSI' ;            
  526.       'SINON' ;         
  527.          vardet = ('/' detip deti) ;
  528.          mivd = 'MINIMUM' vardet ;
  529.          mavd = 'MAXIMUM' vardet ;
  530.          'SI' debug ;
  531.             'MESSAGE' ('CHAINE' 'Mini var jaco = ' mivd ) ;
  532.             'MESSAGE' ('CHAINE' 'Maxi var jaco = ' mavd ) ;
  533.          'FINSI' ;            
  534.          bigvar = 'OU' ('>' mavd fvdet) ('<' mivd ('/' 1.D0 fvdet)) ;
  535.          'SI' bigvar ;
  536.             'SI' debug ;
  537.                ch = 'CHAINE'
  538.                '    Warn : trop grande variation du jaco !' ;
  539.                'MESSAGE' ch ;
  540.             'FINSI' ;                     
  541.          'SINON' ;            
  542.             backok = VRAI ;
  543.             'QUITTER' iback ;
  544.          'FINSI' ;                     
  545.       'FINSI' ;         
  546.    'FIN' iback ;
  547.    'SI' ('NON' backok) ;
  548.       chinfo1 = 'CHAINE'
  549.             'DEDUADAP : Backtracking failed to converge !' ;
  550.       'MESSAGE' chinfo1 ;
  551.       chinfo2 = 'CHAINE' 'Please check the output displacement'
  552.       'MESSAGE' chinfo2 ;
  553.       dep = 'EXCO' lpr dx lpr ;
  554.       'RESPRO' dep ;
  555.       'QUITTER' DEDUADAP ;
  556.    'FINSI' ;
  557.    dx = '+' dx ddxi ;
  558.    'FORME' depx ;
  559.    'SI' ladap ;
  560.       foncip = DEADFONC _mt gdisc methgau theta gamma
  561.                         chpmet metdisc 'ELEM' ;
  562.    'SINON' ;      
  563.       foncip = DEADFONC _mt gdisc methgau theta gamma 'ELEM' ;
  564.    'FINSI' ;      
  565. *
  566. * Critère de convergence
  567. *
  568.    vrrfon = '/' ('-' foncip fonci) fonci ;
  569.    critconv = 'MAXIMUM' vrrfon 'ABS' ;
  570.    tres . &it = critconv ;
  571.    cvgok = ('<' critconv rfonc) ;
  572.    'SI' debug ;
  573.       chmess = 'CHAINE' '  critere    = ' critconv ;
  574.       'MESSAGE' chmess ;
  575.    'FINSI' ;
  576.    deti = detip ;
  577.    fonci = foncip ;
  578.    'SI' debug ;
  579.       tit   = 'CHAINE' 'Maillage ; it=' &it ' crit=' critconv ;
  580.       TRAC 'CACH' mail 'TITR' tit 'NCLK' ;
  581.    'FINSI' ;      
  582.    'SI' cvgok ;
  583.       'QUITTER' it ;
  584.    'FINSI' ;
  585. 'FIN' it ;   
  586. 'FORME' iniform ;
  587. dep = 'EXCO' lpr dx lpr ;
  588. *
  589. itfin = ('-' &it 1) ;
  590. 'SI' debug ;
  591.    ch = 'CHAINE' '  Iteration finale : ' itfin ;
  592.    'MESSAGE' ch ;
  593.    lit = 'PROG' 1. 'PAS' 1. 'NPAS' ('-' itfin 1) ;
  594.    lres = 'PROG' ;
  595.    'REPETER' it itfin ;
  596.       lres = 'ET' lres ('PROG'
  597.          ('/' ('LOG' ('+' (tres . &it ) 1.D-16))
  598.               ('LOG' 10.D0) )) ;
  599.    'FIN' it ;
  600.    titev = 'CHAINE' 'LOG10 Critere (iterations)' ;
  601.    evres = 'EVOL' 'MANU' lit lres 'TITR' titev ;
  602.    'DESSIN' evres ;
  603. 'FINSI' ;
  604. *
  605. 'RESPRO' dep ;
  606. *
  607. * End of procedure file DEDUADAP
  608. *
  609. 'FINPROC' ;
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales