Procédures | Cast3M

* ADAPTE    PROCEDUR  PASCAL    22/04/27    21:15:01     11356          
debproc adapte mot1*'MOT' ;
 
*----------------------------------------------------------------------*
*                             Option MAIL                              *
*----------------------------------------------------------------------*
 
si (ega mot1 'MAIL') ;
 
*------------------------ Lecture des arguments -----------------------*
 
* Lecture du chargement 
argu geo2*maillage cgtot1*chargement ;
 
* Lecture des mots-cles 
imot1 = faux ; imot2 = faux ; imot3 = faux ;
repe b1 3 ;
  argu moti1/'MOT' ;
  si (ega moti1 'DIST') ;
    argu dmin1*flottant ;
    imot1    = vrai ;
    iter b1 ;
  fins ;
  si (ega moti1 'TRAJ') ;
    argu lmin1*flottant ;
    imot2    = vrai ;
    iter b1 ;
  fins ;
  si (ega moti1 'MINI') ;
    argu dabs1*flottant ;
    imot3    = vrai ;
    iter b1 ;
  fins ;
  si (exis moti1) ;
    erreur 19 ;
    quit adapte ;
  fins ;
fin b1 ;
si (non imot1) ;
  erreur '*****  ERREUR : il manque la donnee de DIST' ;
  quit adapte ;
fins ;
si (non imot2) ;
  lmin1    = -1. ;
fins ;
si (non imot3) ;
  dabs1    = -1. ;
sino ;
  si (dabs1 > dmin1) ;
    mess '*****  ATTENTION : le parametre MINI est pris egal a DIST' ;
    dabs1    = dmin1 ;
  fins ;
fins ;
 
*---------------------- Pre-traitement maillages ----------------------*
 
* Extraction des maillages :
ttps1 tmod1 = extr cgtot1 'MODE' tables ;
tgeo1    = table ;
i0       = 0 ;
lmot1    = mots ;
repe b1 (dime ttps1) ;
  modi1    = tmod1 . i0 ;
  tgeo1 . i0 = extr modi1 mail ;
  i0       = i0 + 1 ;
  si (vide lmot1) ;
    si (non (vide modi1)) ;
      lmot1    = extr modi1 depl ;
    fins ;
  fins ;
fin b1 ;
 
* Maillage fin :
repe b1 (dime ttps1) ;
  i0       = &b1 - 1 ;
  si (&b1 ega 1) ; 
    geo1     = tgeo1 . i0 ;
  sino ;
    geoi1    = tgeo1 . i0 ;
    si ((nbel geoi1) > (nbel geo1)) ;
      geo1     = geoi1 ;
    fins ;
  fins ;
fin b1 ;
si ((nbel geo1) < 1) ;
  erreur '*****  ERREUR : le maillage passe dans le chargement est vide' ;
  quit ADAPTE ;
fins ;
 
si ((nbno geo2) > (nbno geo1)) ;
  mess '*****  ATTENTION : le maillage fourni est plus fin que celui a adapter' ;
fins ;
 
* Tolerance geometrique :
tol1     = 1.e-5 * dmin1 ;
tol1     = tol1 / (((flot (nbel geo1)) ** (0.333)) + 1.) ;
 
* Verification points(geo2) inclus dans points(geo1)
*elim (geo1 et geo2) tol1 ;
mpoi1    = chan poi1 geo1 ;
mpoi2    = chan poi1 geo2 ;
si ((nbel (mpoi1 inte mpoi2)) neg (nbel mpoi2)) ;
  erre '*****  ERREUR : les points du maillage fourni doivent etre confondus avec ceux du maillage a adapter' ;
  quit adapte ;
fins ;
 
*----------------------------- Traitement -----------------------------*
 
* Initialisation objets resultats :
ttps3    = table ;
tgeo3    = table ;
ttps4    = table ;
trig4    = table ;
lree1    = prog ;
 
* Coordonnees des noeuds de geo2 :
x1 y1 z1 = geo2 coor ;
pts2     = chan poi1 geo2 ;
 
* Quelques initialisations :
dmin2    = dmin1 ** 2 ;
idabs1   = dabs1 > -1. ;
si idabs1 ;
  dabs2    = dabs1 ** 2 ;
sino ;
  dabs2 = dabs1 ;
fins ;
rmini1   = 0. ;
geoi1p   = vide maillage ;
geoi3p   = vide maillage ;
geo3     = vide maillage ;
i0       = 0 ;
ir0      = 0 ;
repe b1 (dime ttps1) ;
  tpsi1    = ttps1 . (&b1 - 1) ;
  geoi1    = tgeo1 . (&b1 - 1) ;
 
* On evite des traitements peu utiles en forcant le pas adaptation
* a etre au moins egal au part d'apport de matiere :
  si (geoi1 ega geoi1p) ; iter b1 ; fins ;
 
* Maillage grossier :
  ptsi1    = chan poi1 geoi1 ;
  ptsi2    = ptsi1 inte pts2 ;
  si (vide ptsi2) ;
    ttps3 . i0 = tpsi1 ;
    tgeo3 . i0 = geoi1 ;
    i0       = i0 + 1 ;
    iter b1 ;
  fins ;
  geoi2    = geo2 elem appu stri ptsi2 ;
 
* Distances a la source :
  ptxi1    = tire cgtot1 traj tpsi1 ;
  si (&b1 ega 1) ; ptxi1p = ptxi1 ; fins ;
  xp1 yp1 zp1 = ptxi1 coor ;
  xi1 yi1 zi1 = (redu x1 geoi2) (redu y1 geoi2) (redu z1 geoi2) ;
  xi1 yi1 zi1 = (xi1 - xp1) (yi1 - yp1) (zi1 - zp1) ;
  ri1      = (xi1 ** 2) + (yi1 ** 2) + (zi1 ** 2) ;
  chri1    = chan cham ri1 geoi2 ;
  geoi3    = chri1 elem supe dmin2 stri ;
 
* geoi3 : maillage grossier a retrancher de geoi1 :
  si (vide geoi3) ;
    geo3     = geoi1 ;
    rigi1    = vide rigidite ;
    ttps4 . ir0 = tpsi1 ;
    trig4 . ir0 = rigi1 ;
    ir0      = ir0 + 1 ;
  sino ;
    ltrj1    = norm (ptxi1 moin ptxi1p) ;
    si idabs1 ; rmini1   = mini chri1 ; fins ;
    si ((ltrj1 '>' lmin1) ou (&b1 ega 1) ou (rmini1 '<' dabs2)) ;
*mess 'adaptation' ;
      ptxi1p   = ptxi1 ;
      geoix    = geoi1 incl geoi3 volu bary ;
      geoix    = geoi1 diff geoix ;
      geo3     = geoi3 et geoix ;
 
      dgeoi3   = geoi3 diff geoi3p ;
      si ((&b1 neg 1) et (non (vide dgeoi3))) ;
        lree1    = lree1 et tpsi1 ;
        geoi3p   = geoi3 ;
      fins ;
      rigi1    = (enve geoix) rela accro geoi3 lmot1 ;
      ttps4 . ir0 = tpsi1 ;
      trig4 . ir0 = rigi1 ;
      ir0      = ir0 + 1 ;
    sino ;
      geoix    = geoi1 diff geoi1p ;
      geo3     = geo3 et geoix ;
    fins ;
  fins ;
  geoi1p   = geoi1 ;
 
* Tables resultat :
  ttps3 . i0 = tpsi1 ;
  tgeo3 . i0 = geo3 ;
  i0       = i0 + 1 ;
*trac face geo3 ;
 
fin b1 ;
*lree1    = lree1 enle 1 ;
 
* Chargements de sortie :
cggeo3   = char mail ttps3 tgeo3 ;
cgrig4   = char blot ttps4 trig4 ;
 
* Sortie des resultats :
resp (cggeo3 et cgrig4) lree1 ;
 
quit adapte ;
 
* finsi Option MAIL :
fins ;
 
*----------------------------------------------------------------------*
 
* Si mot-cle option pas reconnu : erreur !
erreur 251 ;
 
finproc ;