Télécharger mailtopo.dgibi

Retour à la liste

* fichier : mailtopo.dgibi
************************************************************************
************************************************************************
'OPTI' 'ECHO' 0 ;
graph    = faux ;
interact = faux ;
impr    = 1 ;
for     = '(E11.3)' ;
************************************************************************
* NOM         : MAILTOPO
* DESCRIPTION : Tests du mailleur topologique utilise
*               dans les operateurs TRIA TOPO et REMA
*               Geometries variees mais tenseur metrique homogene et
*               isotrope
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 31/10/2025, version initiale
* HISTORIQUE : v1, 31/10/2025, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
* Procedures
*
* Mini, mediane et maxi d'un MCHAML
'DEBP' MIMEMA ;
'ARGU' ch*'MCHAML' ;
'ARGU' cmp*'MOT' ;
   lr = 'EXTR' (CHGRAV ch) 'VALE' cmp ;
   lro = 'ORDO' lr ; dlr = 'DIME' lr ;
   mil = 'EXTR' lro 1 ; mal = 'EXTR' lro dlr ;
   mel = 'EXTR' lro ('/' ('+' 1 dlr) 2) ;
'FINP' mil mel mal ;
* Passage au gravite d'un MCHAML
'DEBP' CHGRAV ch*'MCHAML';
'FINP' ('CHAN' ch ('MODE' ('EXTR' ch 'MAIL') 'THERMIQUE') 'GRAVITE') ;
************************************************************************
* NOM         : GENTEST
* DESCRIPTION : Génère une table contenant des cas-tests pour
*               utilisation dans mailtopo
*
*    Pour l'instant, tous ces cas ont une métrique constante.
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 28/11/2017, version initiale
* HISTORIQUE : v1, 28/11/2017, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'DEBPROC' GENTEST ;
'ARGUMENT' nomdbase*'MOT' ;
*
ikas  = 0 ;
tkas = 'TABL' ;
*
l2f = 'EGA' nomdbase 'mailtopo_2d_fast' ;
l2s = 'EGA' nomdbase 'mailtopo_2d_slow' ;
l3f = 'EGA' nomdbase 'mailtopo_3d_fast' ;
l3s = 'EGA' nomdbase 'mailtopo_3d_slow' ;
'SI' (l2f 'OU' l2s 'OU' l3f 'OU' l3s) ;
   'SI' ('OU' l2s l2f) ;
      lcont  = 'MOTS' 'QUAD' 'TRIE' 'SELL' 'TOC3' 'TOR2' ;
      'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   'FINS' ;
   'SI' ('OU' l3s l3f) ;
      lcont  = 'MOTS' 'TETE' 'CUBE' 'SEL3' 'CYC2' ;
      'OPTI' 'DIME' 3 'ELEM' 'TET4' ;
   'FINS' ;
   vdim = 'VALE' 'DIME' ;
* braff = 1 : on génère un maillage sans insertion de noeud
* braff = 2 : on génère un maillage avec insertion/suppression de noeud
* braff = 3 : on génère un maillage avec insertion/suppression de noeud y compris au bord
* braff = 4 : on raffine
* braff = 5 : on déraffine
* braff = 6 : on améliore
   'REPE' braff 6 ;
      iraff = &braff ;
*      'REPE' braff 1 ;
*         iraff = 4 ;
      'REPE' bcont ('DIME' lcont) ;
         icont = &bcont ;
         ccont = 'EXTR' lcont icont ;
* Par défaut
         'SI' l2f ;
            lidens = 'LECT' 1 2 3 4 5 ;
            'SI' ('EGA' ccont 'SELL') ;
               lidens = 'LECT' 1 2 3 ;
            'FINS' ;
            'SI' ('OU' ('EGA' ccont 'TOC3') ('EGA' ccont 'TOR2')) ;
               lidens = 'LECT' 1 2 ;
               'SI' ('ET' ('EGA' ccont 'TOR2') ('<' iraff 4)) ;
                  lidens = 'LECT' ;
               'FINS' ;
            'FINS' ;
         'FINS' ;
         'SI' l2s ;
            lidens = 'LECT' 6 ;
            'SI' ('EGA' ccont 'SELL') ;
               lidens = 'LECT' 4 5 ;
            'FINS' ;
            'SI' ('OU' ('EGA' ccont 'TOC3') ('EGA' ccont 'TOR2')) ;
               lidens = 'LECT' 3 4 ;
               'SI' ('ET' ('EGA' ccont 'TOR2') ('<' iraff 4)) ;
                  lidens = 'LECT' ;
               'FINS' ;
            'FINS' ;
         'FINS' ;
         'SI' l3f ;
            lidens = 'LECT' 1 2 ;
         'FINS' ;
         'SI' l3s ;
            lidens = 'LECT' 3 ;
         'FINS' ;
*
         ddens = 'DIME' lidens ;
         'SI' ('>' ddens 0) ;
         'REPE' bidens ddens ;
            idens = 'EXTR' lidens &bidens ;
*
            ikas = '+' ikas 1 ;
            tkas . ikas = 'TABL' ; tloc = tkas . ikas ;
*
            idk = 'CHAI' 'r' iraff 'c' ccont 'd' idens ;
            tloc . 'idk' = idk ;
            'MESS' ('CHAI' 'Generation cas ' ikas ' ' idk) ;
* Génération de la topologie initiale
            'SI' ('EXIS' ('LECT' 1 2 3) iraff) ;
               topoini = gencont ccont idens ;
               lcar = 0.0 ;
            'FINS' ;
            'SI' ('EGA' iraff 4) ;
               cini = gencont ccont 1 ;
               'SI' ('EGA' vdim 2) ;
                  topoini = 'SURF' cini ;
               'SINO' ;
*                  topoini = 'VOLU' cini 'VERB' ;
                  topoini = 'VOLU' cini ;
               'FINS' ;
               lcar = '/' 1. ('FLOT' idens) ;
            'FINS' ;
            'SI' ('EXIS' ('LECT' 5 6) iraff) ;
               cini = gencont ccont idens ;
               'SI' ('EGA' vdim 2) ;
                  topoini = 'SURF' cini ;
               'SINO' ;
*                  topoini = 'VOLU' cini 'VERB' ;
                  topoini = 'VOLU' cini ;
               'FINS' ;
               'SI' ('EGA' iraff 5) ;
                  lcar = 2. ;
               'FINS' ;
               'SI' ('EGA' iraff 6) ;
                  lcar = '/' 1. ('FLOT' idens) ;
               'FINS' ;
            'FINS' ;
            tloc . 'topoini' = topoini ;
            tloc . 'lcar'    = lcar ;
            'SI' ('EXIS' ('LECT' 1 2 3) iraff) ;
               tloc . 'ijob'   = '-' iraff 1 ;
            'SINO' ;
               tloc . 'ijob'   = 3 ;
            'FINS' ;
         'FIN' bidens ;
         'FINS' ;
      'FIN' bcont ;
   'FIN' braff ;
'FINS' ;
*
*
'RESPRO' tkas ;
*
* End of procedure file GENTEST
*
'FINPROC' ;
************************************************************************
* NOM         : GENCONT
* DESCRIPTION :
*
* Procédure pour générer un contour ou une enveloppe dont on veut mailler
* l'intérieur
* SELL : en forme de pointe de flèche
*        on peut donner 1,2 ou 4 arguments entiers qui sont les nombres
*        de mailles des cotes
* TORE : deux cercles concentriques
*        on peut donner 1 ou 2 arguments entiers qui sont le nombre de
*        mailles/4 de chaque cercle
*        On peut donner 2 arguments flottants qui sont le rapport
*        d'homothetie et un angle de rotation
*
*
*
* LANGAGE     : GIBIANE-CAST3M
* AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
*               mél : stephane.gounand@cea.fr
**********************************************************************
* VERSION    : v1, 25/08/2016, version initiale
* HISTORIQUE : v1, 25/08/2016, création
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
*
'DEBPROC' GENCONT ;
'ARGUMENT' mcle*'MOT' ;
*
lmail = 'MOTS' 'SELL' 'TORE' 'TOCO' 'TOC2' 'ISOC' 'TETR' 'CYCU' 'CERV'
 'CRV2' 'TRIE' 'TRIR' 'QUAD' 'TETE' 'CUBE' 'SEL3' 'CYC2' 'TOC3' 'CYCO'
 'TOR2' ;
imail = 'POSI' mcle 'DANS' lmail ;
'SI' ('EGA' imail 0) ;
   cherr = 'CHAINE' 'Mot cle ' mcle ' inconnu' ;
   'ERREUR' cherr ;
'FINSI' ;
*
* 'SELL'
*
'SI' ('EGA' imail 1) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 1 ; n2 = n1 ; n3 = n2 ; n4 = n2 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ; n2 = n1 ; n3 = n2 ; n4 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = n1 ; n3 = tn . 2 ; n4 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 4) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = tn . 3 ; n4 = tn . 4 ;
   'FINSI' ;
*
   pA = -1. 2. ;
   pB =  0. 0. ;
   pC =  1. 2. ;
   pD =  0. 1. ;
*
   lAB = 'DROIT' n1 pA pB ; lBC = 'DROIT' n2 pB pC ;
   lCD = 'DROIT' n3 pC pD ; lDA = 'DROIT' n4 pD pA ;
*
   cnt = lAB 'ET' lBC 'ET' lCD 'ET' lDA ;
'FINSI' ;
*
* 'TORE'
*
'SI' ('EGA' imail 2) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 1 ; n2 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ; n2 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
   'FINSI' ;
   tn = 'TABLE' ;
   'REPETER' liflo ;
      'ARGUMENT' iflo/'FLOTTANT' ;
      'SI' ('EXISTE' iflo) ;
         tn . &liflo = iflo ;
      'SINON' ;
         'QUITTER' liflo ;
      'FINSI' ;
   'FIN' liflo ;
   dtn = 'DIME' tn ;
   rhomo = 2. ; angle = 0. ;
   'SI' ('>EG' dtn 1) ;
      rhomo = tn . 1 ;
   'FINSI' ;
   'SI' ('>EG' dtn 2) ;
      angle =  tn . 2 ;
   'FINSI' ;
   n1 = '*' n1 2 ;
   n2 = '*' n2 2 ;
*
   pA = 1. 0. ;   pB = 0. 1. ;   pC =  -1. 0. ;   pD =  0. -1. ;
   pE pF pG pH = 'HOMOTHETIE' pA pB pC pD rhomo (0. 0.) ;
   pE pF pG pH = 'TOURNER' pE pF pG pH angle (0. 0.) ;
 
*
   lEG = 'CER3' n2 pE pF pG ;
   lGE = 'CER3' n2 pG pH pE ;
   cere = lEG 'ET' lGE ;
*
   lAC = 'CER3' n1 pA pB pC ;
   lCA = 'CER3' n1 pC pD pA ;
   ceri = 'INVERSE' (lAC 'ET' lCA) ;
*
   cnt = ceri 'ET' cere ;
'FINSI' ;
*
* 'TOCO'
*
'SI' ('EGA' imail 3) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 1 ; n2 = n1 ; n3 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ; n2 = n1 ; n3 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 3) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = tn . 3 ;
   'FINSI' ;
   tn = 'TABLE' ;
   'REPETER' liflo ;
      'ARGUMENT' iflo/'FLOTTANT' ;
      'SI' ('EXISTE' iflo) ;
         tn . &liflo = iflo ;
      'SINON' ;
         'QUITTER' liflo ;
      'FINSI' ;
   'FIN' liflo ;
   dtn = 'DIME' tn ;
   rhomo = 2. ; angle = 0. ; ouvert = 0. ;
   'SI' ('>EG' dtn 1) ;
      rhomo = tn . 1 ;
   'FINSI' ;
   'SI' ('>EG' dtn 2) ;
      angle =  tn . 2 ;
   'FINSI' ;
   'SI' ('>EG' dtn 3) ;
      ouvert =  tn . 3 ;
   'FINSI' ;
   n1 = '*' n1 2 ;
   n2 = '*' n2 2 ;
*
   pAp = 1. ouvert ;   pB = 0. 1. ;   pC =  -1. 0. ;   pD =  0. -1. ;
   pAm = 1. ('*' ouvert -1.) ;
   pEp pEm pF pG pH = 'HOMOTHETIE' pAp pAm pB pC pD rhomo (0. 0.) ;
   pEp pEm pF pG pH = 'TOURNER' pEp pEm pF pG pH angle (0. 0.) ;
 
*
   lEG = 'CER3' n2 pEp pF pG ;
   lGE = 'CER3' n2 pG pH pEm ;
   lEA = 'DROIT' n3 pEm pAm ;
   lAC = 'CER3' n1 pAm pD pC ;
   lCA = 'CER3' n1 pC pB pAp ;
   lAE = 'DROIT' n3 pAp pEp ;
   cnt= LEG 'ET' lGE 'ET' lEA 'ET' lAC 'ET' lCA 'ET' lAE ;
*
'FINSI' ;
*
* 'TOC2'
*
'SI' ('EGA' imail 4) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 2 ; n2 = n1 ; n3 = n1 ; n4 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ; n2 = n1 ; n3 = n1 ; n4 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = n1 ; n4 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 3) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = tn . 3 ; n4 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 4) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = tn . 3 ; n4 = tn . 4 ;
   'FINSI' ;
   tn = 'TABLE' ;
   'REPETER' liflo ;
      'ARGUMENT' iflo/'FLOTTANT' ;
      'SI' ('EXISTE' iflo) ;
         tn . &liflo = iflo ;
      'SINON' ;
         'QUITTER' liflo ;
      'FINSI' ;
   'FIN' liflo ;
   dtn = 'DIME' tn ;
   rhomo = 2. ; angle = 0. ; ouvert = 1.D-7 ;
   'SI' ('>EG' dtn 1) ;
      rhomo = tn . 1 ;
   'FINSI' ;
   'SI' ('>EG' dtn 2) ;
      angle =  tn . 2 ;
   'FINSI' ;
   'SI' ('>EG' dtn 3) ;
      ouvert =  tn . 3 ;
   'FINSI' ;
*
   pAp = 1. ouvert ;   pC =  -1. 0. ;
   pAm = 1. ('*' ouvert -1.) ;
   pEp pEm pG = 'HOMOTHETIE' pAp pAm pC rhomo (0. 0.) ;
   pEp pEm pG = 'TOURNER' pEp pEm pG angle (0. 0.) ;
 
*
   cE = 'CER3' n1 pEp pG pEm ;
   lEA = 'DROIT' n2 pEm pAm ;
   cA = 'CER3' n3 pAm pC pAp ;
   lAE = 'DROIT' n4 pAp pEp ;
   cnt= cE 'ET' lEA 'ET' cA 'ET' lAE ;
*
'FINSI' ;
*
* 'ISOC'
*
'SI' ('EGA' imail 5) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 2 ; n2 = n1 ; n3 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ; n2 = n1 ; n3 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 3) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = tn . 3 ;
   'FINSI' ;
   tn = 'TABLE' ;
   'REPETER' liflo ;
      'ARGUMENT' iflo/'FLOTTANT' ;
      'SI' ('EXISTE' iflo) ;
         tn . &liflo = iflo ;
      'SINON' ;
         'QUITTER' liflo ;
      'FINSI' ;
   'FIN' liflo ;
   dtn = 'DIME' tn ;
   angle = 60. ;
   'SI' ('>EG' dtn 1) ;
      angle = tn . 1 ;
   'FINSI' ;
*
   pA = 0. 0. ; pB = 1. 0. ; pc = ('COS' angle) ('SIN' angle) ;
   lAB = 'DROIT' n1 pA pB ;
   lBC = 'DROIT' n2 pB pC ;
   lCA = 'DROIT' n3 pC pA ;
*
   cnt= lAB 'ET' lBC 'ET' lCA ;
*
'FINSI' ;
*
* 'TETR' ou 'TETE'
*
'SI' ('OU' ('EGA' imail 6) ('EGA' imail 13)) ;
   'OPTI' 'DIME' 3 'ELEM' 'TET4' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 1 ; n2 = n1 ; n3 = n1 ;n4 = n1 ; n5 = n1 ; n6 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ;
      n2 = n1 ; n3 = n1 ;n4 = n1 ; n5 = n1 ; n6 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
      n3 = n1 ;n4 = n1 ; n5 = n1 ; n6 = n1 ;
   'FINSI' ;
*
   'SI' ('EGA' imail 6) ;
      pA = 0. 0. 0. ; pB = 1. 0. 0. ; pC = 0. 1. 0. ; pD = 0. 0. 1. ;
   'FINS' ;
   'SI' ('EGA' imail 13) ;
      uns2  = 0.5 ; muns2 = -0.5 ;
      unsr8 = 8. '**' -0.5 ; munsr8 = '*' unsr8 -1. ;
      pA = muns2 0. munsr8 ; pB = uns2 0. munsr8 ;
      pC = 0. uns2 unsr8 ; pD = 0. muns2 unsr8 ;
   'FINS' ;
* Aretes
   lAB = 'DROIT' n1 pA pB ;
   lBC = 'DROIT' n2 pB pC ;
   lCA = 'DROIT' n3 pC pA ;
   lBD = 'DROIT' n4 pB pD ;
   lDA = 'DROIT' n5 pD pA ;
   lCD = 'DROIT' n6 pC pD ;
* Orientations importantes !! reprises de 'CHAN' 'SURFACE'
*  Faces ABC, BDC, CDA, ADB
   cABC = lAB 'ET' lBC 'ET' lCA ;
   cBDC = lBD 'ET' ('INVE' lCD) 'ET' ('INVE' lBC) ;
   cCDA = lCD 'ET' lDA 'ET' ('INVE' lCA) ;
   cADB = ('INVE' lDA) 'ET' ('INVE' lBD) 'ET' ('INVE' lAB) ;
   sABC = 'SURFACE'  cABC 'PLANE' ;
   sBDC = 'SURFACE'  cBDC 'PLANE' ;
   sCDA = 'SURFACE'  cCDA 'PLANE' ;
   sADB = 'SURFACE'  cADB 'PLANE' ;
   cnt = sABC 'ET' sBDC 'ET' sCDA 'ET' sADB ;
*
'FINSI' ;
*
* 'CYCU' Un cylindre dans un cube 'CYCO' la meme chose mais bien orienté
*
'SI' ('OU' ('EGA' imail 7) ('EGA' imail 18)) ;
   'OPTI' 'DIME' 3 'ELEM' 'TET4' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 2 ; n2 = 1 ; n3 = 1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ;
      n2 = n1 ; n3 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 3) ;
      n1 = tn . 1 ; n2 = tn . 2 ; n3 = tn . 3 ;
   'FINSI' ;
*
   tn = 'TABLE' ;
   'REPETER' liflo ;
      'ARGUMENT' iflo/'FLOTTANT' ;
      'SI' ('EXISTE' iflo) ;
         tn . &liflo = iflo ;
      'SINON' ;
         'QUITTER' liflo ;
      'FINSI' ;
   'FIN' liflo ;
   dtn = 'DIME' tn ;
   rcyl = 0.75 ; angle = 0. ;
   'SI' ('>EG' dtn 1) ;
      rcyl = tn . 1 ;
   'FINSI' ;
   'SI' ('>EG' dtn 2) ;
      angle =  tn . 2 ;
   'FINSI' ;
*
   mrcyl = ('*' rcyl -1.) ;
   pA = rcyl 0. 0. ; pB = 0. rcyl 0. ; pC = mrcyl 0. 0. ;
   pD = 0. mrcyl 0. ;
   pA pB pC pD = 'TOURNER' pA pB pC pD (0. 0. 0.) (0. 0. 1.) angle ;
   pE = 1. -1. 0. ; pF = 1. 1. 0. ; pG = -1. 1. 0. ; pH = -1. -1. 0. ;
*
   ctc1 = 'CER3' n1 pA pB pC ;   ctc2 = 'CER3' n1 pC pD pA ;
   cerb = ctc1 'ET' ctc2 ;
   carb = 'DROIT' n2 pE pF 'DROIT' n2 pG 'DROIT' n2 pH 'DROIT'
      n2 pE ;
   bas = 'SURFACE' ('ET' carb ('INVERSE' cerb)) 'PLANE' ;
   hau cerh carh = 'PLUS' bas cerb carb (0. 0. 2.) ;
   suri = 'REGLER' n3 cerb cerh ;
   sure = 'REGLER' n3 carb carh ;
   'SI' ('EGA' imail 7) ;
      cnt = bas 'ET' hau 'ET' suri 'ET' sure ;
   'FINS' ;
   'SI' ('EGA' imail 18) ;
      cnt = bas 'ET' ('INVE' hau) 'ET' suri 'ET' ('INVE' sure) ;
   'FINS' ;
*
'FINSI' ;
*
* 'CERV' Cerveau
*
'SI' ('EGA' imail 8) ;
   'ERRE' 'Non disponible' ;
*   'OPTI' 'REST' '/test4/gounand/rebecca/cerveauf42.sauv' ;
   cnt = bbord ;
*
'FINSI' ;
*
* 'CRV2' Cerveau 2
*
'SI' ('EGA' imail 9) ;
   'ERRE' 'Non disponible' ;
*   'OPTI' 'REST' '/test4/gounand/rebecca/cerv143_best.sauv' ;
*
'FINSI' ;
*
* 'TRIE' Triangle Equilateral 'TRIR' Triangle Isocel rectangle
*
'SI' ('OU' ('EGA' imail 10) ('EGA' imail 11)) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 1 ; n2 = n1 ; n3 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ;
      n2 = n1 ; n3 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
      n3 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 3) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
      n3 = tn . 3 ;
   'FINSI' ;
   'SI' ('EGA' imail 10) ;
      pA = 0. 0. ; pB = 1. 0. ; pC = 0.5 ('SIN' 60.) ;
   'FINSI' ;
   'SI' ('EGA' imail 11) ;
      pA = 0. 0. ; pB = 1. 0. ; pC = 0. 1. ;
   'FINSI' ;
   lAB = 'DROIT' n1 pA pB ;
   lBC = 'DROIT' n2 pB pC ;
   lCA = 'DROIT' n3 pC pA ;
*
   cnt= lAB 'ET' lBC 'ET' lCA ;
*
'FINSI' ;
*
* 'QUAD' Quadrangle
*
'SI' ('EGA' imail 12) ;
   'OPTI' 'DIME' 2 'ELEM' 'TRI3' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   n1 = 1 ; n2 = n1 ; n3 = n1 ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ;
      n2 = n1 ; n3 = n1 ; n4 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 2) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
      n3 = n1 ; n4 = n2 ;
   'FINSI' ;
   'SI' ('EGA' dtn 3) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
      n3 = tn . 3 ; n4 = n1 ;
   'FINSI' ;
   'SI' ('EGA' dtn 4) ;
      n1 = tn . 1 ; n2 = tn . 2 ;
      n3 = tn . 3 ; n4 = tn . 4 ;
   'FINSI' ;
   pA = 0. 0. ; pB = 1. 0. ; pC = 1. 1. ; pD = 0. 1. ;
   lAB = 'DROIT' n1 pA pB ;
   lBC = 'DROIT' n2 pB pC ;
   lCD = 'DROIT' n3 pC pD ;
   lDA = 'DROIT' n4 pD pA ;
*
   cnt= lAB 'ET' lBC 'ET' lCD 'ET' lDA ;
*
'FINSI' ;
*
* 'CUBE' Cube
*
'SI' ('EGA' imail 14) ;
   'OPTI' 'DIME' 3 'ELEM' 'TET4' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ;
   'SINO' ;
      'ERRE' 5 ;
   'FINSI' ;
*
   pA = 0. 0. 0. ; pB = 1. 0. 0. ; pC = 1. 1. 0. ; pD = 0. 1. 0. ;
   pE = 0. 0. 1. ; pF = 1. 0. 1. ; pG = 1. 1. 1. ; pH = 0. 1. 1. ;
* Aretes
   lAB = 'DROIT' n1 pA pB ;
   lBC = 'DROIT' n1 pB pC ;
   lCD = 'DROIT' n1 pC pD ;
   lDA = 'DROIT' n1 pD pA ;
*
   lEF = 'DROIT' n1 pE pF ;
   lFG = 'DROIT' n1 pF pG ;
   lGH = 'DROIT' n1 pG pH ;
   lHE = 'DROIT' n1 pH pE ;
*
   lAE = 'DROIT' n1 pA pE ;
   lBF = 'DROIT' n1 pB pF ;
   lCG = 'DROIT' n1 pC pG ;
   lDH = 'DROIT' n1 pD pH ;
*
* Orientations importantes !! reprises de 'CHAN' 'SURFACE'
*  Faces EHGF, DCGH, BFGC, ADHE, AEFB, ABCD
   cEHGF = ('INVE' lHE) 'ET' ('INVE' lGH) 'ET' ('INVE' lFG) 'ET'
           ('INVE' lEF) ;
   cDCGH = ('INVE' lCD) 'ET' lCG 'ET' lGH 'ET' ('INVE' lDH) ;
   cBFGC = lBF 'ET' lFG 'ET' ('INVE' lCG) 'ET' ('INVE' lBC) ;
   cADHE = ('INVE' lDA) 'ET' lDH 'ET' lHE 'ET' ('INVE' lAE) ;
   cAEFB = lAE 'ET' lEF 'ET' ('INVE' lBF) 'ET' ('INVE' lAB) ;
   cABCD = lAB 'ET' lBC 'ET' lCD 'ET' lDA ;
*
   sEHGF = 'SURF' cEHGF 'PLANE' ;
   sDCGH = 'SURF' cDCGH 'PLANE' ;
   sBFGC = 'SURF' cBFGC 'PLANE' ;
   sADHE = 'SURF' cADHE 'PLANE' ;
   sAEFB = 'SURF' cAEFB 'PLANE' ;
   sABCD = 'SURF' cABCD 'PLANE' ;
 
   cnt= sEHGF 'ET' sDCGH 'ET' sBFGC 'ET' sADHE 'ET' sAEFB 'ET' sABCD ;
*
'FINSI' ;
*
* 'SEL3' Equivalent de SELL en 3D
*
'SI' ('EGA' imail 15) ;
   'OPTI' 'DIME' 3 'ELEM' 'TET4' ;
   tn = 'TABLE' ;
   'REPETER' lient ;
      'ARGUMENT' ient/'ENTIER' ;
      'SI' ('EXISTE' ient) ;
         tn . &lient = ient ;
      'SINON' ;
         'QUITTER' lient ;
      'FINSI' ;
   'FIN' lient ;
   dtn = 'DIME' tn ;
   'SI' ('EGA' dtn 1) ;
      n1 = tn . 1 ;
   'SINO' ;
      'ERRE' 5 ;
   'FINSI' ;
*
   uns2  = 0.5 ; muns2 = -0.5 ;
   unsr8 = 8. '**' -0.5 ; munsr8 = '*' unsr8 -1. ;
   pA = muns2 0. munsr8 ; pB = uns2 0. munsr8 ;
   pC = 0. uns2 unsr8 ; pD = 0. muns2 unsr8 ;
   pE pF = 'HOMO' pA pB 2. ('BARY' (pC 'ET' pD)) ;
* Aretes
   lAB = 'DROIT' n1 pA pB ;
   lBC = 'DROIT' n1 pB pC ;
   lCA = 'DROIT' n1 pC pA ;
   lBD = 'DROIT' n1 pB pD ;
   lDA = 'DROIT' n1 pD pA ;
*
   lEF = 'DROIT' n1 pE pF ;
   lFC = 'DROIT' n1 pF pC ;
   lCE = 'DROIT' n1 pC pE ;
   lFD = 'DROIT' n1 pF pD ;
   lDE = 'DROIT' n1 pD pE ;
* Orientations importantes !! reprises de 'CHAN' 'SURFACE'
*  Faces EFC, FDBC, ECAD, EDF
*  Faces CBA,             ABD
   cEFC  = lEF 'ET' lFC 'ET' lCE ;
   cFDBC = lFD 'ET' ('INVE' lBD) 'ET' lBC 'ET' ('INVE' lFC) ;
   cECAD = ('INVE' lCE) 'ET' lCA 'ET' ('INVE' lDA) 'ET' lDE ;
   cEDF  = ('INVE' lDE) 'ET' ('INVE' lFD) 'ET' ('INVE' lEF) ;
   cCBA  = ('INVE' lBC) 'ET' ('INVE' lAB) 'ET' ('INVE' lCA) ;
   cABD  = lAB 'ET' lBD 'ET' lDA ;
 
*
   sEFC  = 'SURF' cEFC   'PLANE' ;
   sFDBC = 'SURF' cFDBC  'PLANE' ;
   sECAD = 'SURF' cECAD  'PLANE' ;
   sEDF  = 'SURF' cEDF   'PLANE' ;
   sCBA  = 'SURF' cCBA   'PLANE' ;
   sABD  = 'SURF' cABD   'PLANE' ;
*
   cnt = sEFC 'ET' sFDBC 'ET' sECAD 'ET' sEDF 'ET' sCBA 'ET' sABD ;
*
'FINSI' ;
*
* 'CYC2' Raccourci pour les arguments de CYCU
*
'SI' ('EGA' imail 16) ;
   'ARGU' ient*'ENTIER' ;
*
*   'MESS' 'Avant appel' ;
   cnt = GENCONT 'CYCO' ('*' ient 2) ient ient
      0.88 5. ;
*   'MESS' 'Apres appel' ;
*
'FINSI' ;
*
* 'TOC3' Raccourci pour les arguments de TOCO
*
'SI' ('EGA' imail 17) ;
   'ARGU' ient*'ENTIER' ;
*
   cnt = GENCONT 'TOCO' ient 2. 0. 0.001 ;
*
'FINSI' ;
*
* 'TOR2' Raccourci pour les arguments de TORE
*
'SI' ('EGA' imail 19) ;
   'ARGU' ient*'ENTIER' ;
*
   cnt = GENCONT 'TORE' ient 2. 5. ;
*
'FINSI' ;
*
'RESPRO' cnt ;
*
* End of procedure file GENCONT
*
'FINPROC' ;
*
* Fin Procedures
*
* lgentest = vrai : On génère la base sous forme de .sauv
* lgentest = faux : On lit la base et on vérifie.
lgentest = vrai ;
lsauv    = faux ;
*
tbas = 'TABL' ; ibas = 0 ;
*
* On ne peut pas encore faire isens=1 pour cause de pas de 'INVE' LIST
*
*
*
ibas = ibas '+' 1 ; tbas . ibas = 'TABL' ; tibas = tbas . ibas ;
tibas . 'nombase' = 'mailtopo_2d_fast' ;
tibas . 'nomdate' = '20171218_135310' ;
* Pas de cas en erreur dans cette base
* Le cas 44 / 96 r3cTOC3d1  TRIA TOPO AJNO BORD ne converge pas sur le volume
* Le cas 45 / 96 r3cTOC3d2  TRIA TOPO AJNO BORD ne converge pas sur le volume
tibas . 'lkerrref' = 'LECT' 44 45 ;
tibas . 'lcvgrref' = 'LECT' ;
*
ibas = ibas '+' 1 ; tbas . ibas = 'TABL' ; tibas = tbas . ibas ;
tibas . 'nombase' = 'mailtopo_2d_slow' ;
tibas . 'nomdate' = '20171218_135311' ;
* Le cas 5 / 42  r1cTOC3d3  TRIA TOPO NOAJ ne converge pas sur le volume
* Depuis la mise a zero agressive du critere quali6 (2026-06-10) : plus de pbs
* Le cas 17 / 42 r3cTOC3d3  TRIA TOPO AJNO BORD ne converge pas sur le volume
* Le cas 18 / 42 r3cTOC3d4  TRIA TOPO AJNO BORD ne converge pas sur le volume
tibas . 'lkerrref' = 'LECT' 17 18 ;
tibas . 'lcvgrref' = 'LECT' ;
*
ibas = ibas '+' 1 ; tbas . ibas = 'TABL' ; tibas = tbas . ibas ;
tibas . 'nombase' = 'mailtopo_3d_fast' ;
tibas . 'nomdate' = '20171218_135312' ;
* Le cas 30 r4cSEL3d2  perd son bord (a regarder)
*tibas . 'lkerrref' = 'LECT' 30 ;
* Depuis l'implementation des noeuds virtuels multiples
* (2025-11-19) : plus de pbs.
* Le cas : 21 / 48 r3cSEL3d1  TRIA TOPO AJNO BORD Bord non simple et ne converge pas sur le volume
tibas . 'lkerrref' = 'LECT' 21 ;
* Le cas : 32 / 48 r4cCYC2d2  REMA AJNO ne convergeait pas.
* 2026/01/06 : plus de pbs avec JCRIT=4 ou 5 dans quali6.eso
tibas . 'lcvgrref' = 'LECT' ;
*
ibas = ibas '+' 1 ; tbas . ibas = 'TABL' ; tibas = tbas . ibas ;
tibas . 'nombase' = 'mailtopo_3d_slow' ;
tibas . 'nomdate' = '20171218_135318' ;
* Pas de cas en erreur dans cette base
* Le cas : 12 / 24 r3cCYC2d3 TRIA TOPO AJNO BORD 4 elements de volume nul
* 2026/01/05 : Suite au parcours des topologies de volume nul dans topv2
*              Le cas 12 remarche
tibas . 'lkerrref' = 'LECT' ;
* Le cas : 22 / 24  r6cCUBEd3 REMA AJNO ne convergeait pas.
* 2026/01/06 : plus de pbs avec JCRIT=4 ou 5 dans quali6.eso
tibas . 'lcvgrref' = 'LECT' ;
'SI' faux ;
'FINS' ;
*
'OPTI' debu 0 echo 0 ;
'SI' interact ;
   'OPTI' 'TRAC' 'X' ;
'SINO' ;
   'OPTI' 'TRAC' 'PSC' ;
'FINS' ;
*
* Paramètres globaux
*
* lsyntax = 2 : passage de la densité constante à l'opérateur sous forme
* d'un réel
* lsyntax = 3 : passage de la densité constante à l'opérateur sous forme
*               d'un chpoint à une composante (inverse du tenseur
*               métrique proportionnel à I diagonal)
* lsyntax = 4 : passage de la densité constante à l'opérateur sous forme
*               d'un chpoint à d(d+1)/2 composantes (tenseur
*               anisotrope en x y z)
*
lsyntax = 4 ;
*
nsoucbas = 0 ;
ncvgbas  = 0 ;
*
nbas = 'DIME' tbas ;
*!nbas = 1 ;
'REPE' bclbas nbas;
   ibas = &bclbas ;
*!   ibas=3 ;
   tibas = tbas . ibas ;
   nombase = tibas . 'nombase' ;
   nomdate = tibas . 'nomdate' ;
   lcaserr = 'LECT' ;
   lcvgerr = 'LECT' ;
*
mmdat = mydate ;
'SI' ('NON' interact) ;
   'OPTI' 'TRAC' 'PSC' ;
   'SI' lsauv ;
      nomfic   = 'CHAI' 'sauv/' nombase '_' mmdat
      '.ps' ;
      'MESS' ('CHAI' 'Fichier image' ' ' nomfic) ;
      'OPTI' 'FTRA' nomfic ;
      'OPTI' 'ECHO' 0 ;
      nomfic   = 'CHAI' 'sauv/' nombase '_' mmdat
      '.txt' ;
      'MESS' ('CHAI' 'Fichier echo' ' ' nomfic) ;
      oimpr = 'VALE' 'IMPR' ;
      'OPTI' 'IMPR' 10 'IMPR' nomfic ;
*   'SINO' ;
*      nomfic   = 'CHAI' nombase '_' mmdat '.ps' ;
*      'MESS' ('CHAI' 'Fichier image ' nomfic) ;
*      'OPTI' 'FTRA' nomfic ;
   'FINS' ;
'FINSI' ;
*
**************************************************************************
*        Début JDD
*
* DESCRIPTION : IJOB=0
*               Minimise le volume d'une topologie de maillage
*               en le maintenant supérieur à 0
*               IJOB=1
*               Minimise le volume, mais on a le droit d'ajouter/supprimer
*               des noeuds internes
*               IJOB=2
*               Minimise le volume, mais on a le droit d'ajouter/supprimer
*               des noeuds internes et au bord
*               IJOB=3
*               La topologie de maillage est supposée être un maillage
*               On essaie de l'améliorer en conservant son volume
*               mais en augmentant sa qualité grace a l'adjonction
*               de noeuds internes
*
tikas = GENTEST nombase ;
tibas . 'tikas' = tikas ;
*
* Boucle de test
*
vdim = 'VALE' 'DIME' ;
'SI' ('ET' interact ('EGA' vdim 3)) ; 'OPTI' 'TRAC' 'OPEN' ; 'FINS' ;
nkas = 'DIME' tikas ;
'SAUT' 2 'LIGNE' ;
'MESS' '****************************************************************' ;
'MESS' '                   ' nombase ' :' ' ' nkas ' cas'  ;
'MESS' '****************************************************************' ;
'SAUT' 2 'LIGNE' ;
nsouckas = 0 ;
ncvgkas = 0 ;
 
*!nkas = 1;
'REPE' bkas nkas ;
* Récupération des données du test
   ikas = &bkas ;
*!   ikas = 10 ;
   tloc = tikas . ikas ;
   topoini = tloc . 'topoini' ;
   lcar    = tloc . 'lcar'    ;
   ijob    = tloc . 'ijob'    ;
   idk     = tloc . 'idk'     ;
'SAUT' 1 'LIGN' ;
'MESS' ('CHAI' 'Numero du cas :' ' '  ikas ' /' ' ' nkas ' ' idk ' ' nombase) ;
*RESUPAR ;
'SAUT' 1 'LIGN' ;
*
'SI' ('EGA' ijob 3) ;
   'SI' ('EGA' lsyntax 2) ;
      metmo = 'CSTE' ;
      metva = lcar ;
   'FINS' ;
   'SI' ('EGA' lsyntax 3) ;
      metmo = 'ISOT' ;
      coef = lcar '**' -2 ;
      metva = 'MANU' 'CHPO' topoini 1 'G' coef 'NATURE' 'DIFFUSE' ;
   'FINS' ;
   'SI' ('EGA' lsyntax 4) ;
      metmo = 'CHAI' 'ANIS' ;
      coef = lcar '**' -2 ;
      'SI' ('EGA' vdim 2) ;
         metva = 'MANU' 'CHPO' topoini 3 'G11' coef 'G21' 0. 'G22' coef
            'NATURE' 'DIFFUSE' ;
      'SINO' ;
         metva = 'MANU' 'CHPO' topoini 6 'G11' coef 'G21' 0. 'G22' coef
          'G31' 0. 'G32' 0. 'G33' coef 'NATURE' 'DIFFUSE' ;
      'FINS' ;
   'FINS' ;
'FINS' ;
*
* Comme les tests sont un peu coûteux, on ne verifie que la base 1
'SI' ('EGA' ibas 1) ;
   iseqm = 1 ; vseqm = 1 ;
   iopto = 0 ; vopto = 2 ; isegadj = 0 ;
   nprema = 2 ;
'SINO' ;
  iseqm = 0 ; vseqm = 0 ;
  iopto = 0 ; vopto = 0 ; isegadj = 0 ;
   nprema = 1 ;
'FINS' ;
* Optionnel
tparam = 'TABL' ;
tparam . 'impr'  = impr ;
tparam . 'nbpasses_rema' = nprema ;
* tparam . 'critquals'  = enum (prog 1 2. 1.)
tparam . 'graph' = graph ;
tparam . 'id_cas' = idk ;
tparam . 'max_iter'  = 100 ;
tparam . 'sort_seqm' = iseqm ;
tparam . 'veri_seqm' = vseqm ;
tparam . 'veri_opto' = vopto ;
tparam . 'impr_opto' = iopto ;
tparam . 'impr_segadj_opto' = isegadj ;
tparam . 'strat_fast' = faux ;
*
'SOUC' 0 ;
*
'SI' ('EGA' ijob 0) ;
   'MESS' 'Appel TRIA TOPO NOAJ' ;
   curtopo = 'TRIA' 'TOPO' topoini 'NOAJ' tparam ;
'FINS' ;
'SI' ('EGA' ijob 1) ;
   'MESS' 'Appel TRIA TOPO AJNO' ;
   curtopo = 'TRIA' 'TOPO' topoini 'AJNO' tparam ;
'FINS' ;
'SI' ('EGA' ijob 2) ;
   'MESS' 'Appel TRIA TOPO AJNO BORD' ;
   curtopo = 'TRIA' 'TOPO' topoini ('VIDE' 'MAILLAGE') 'AJNO' tparam ;
'FINS' ;
'SI' ('EGA' ijob 3) ;
   'MESS' 'Appel REMA AJNO' ;
   curtopo metvan = 'REMA' topoini metva 'IPOL' 'AJNO' tparam ;
'FINS' ;
'SI' ('NEG' ijob 3) ;
   qcurtopo = 'INDI' 'EQLT' curtopo ;
   miqa meqa maqa = MIMEMA qcurtopo 'EQLT' ;
   'MESS'  'FORMAT' for idk ' Qeqltmin=' miqa ' Qeqltmed=' meqa ' Qeqltmax=' maqa ;
'SINO' ;
   qcurtopo = 'INDI' 'COHE' 'DENS' curtopo metvan ;
   miqa meqa maqa = MIMEMA qcurtopo 'COHE' ;
   'MESS'  'FORMAT' for idk ' Qcohemin=' miqa ' Qcohemed=' meqa ' Qcohemax=' maqa ;
   miqe meqe maqe = MIMEMA qcurtopo 'DENS' ;
   'MESS'  'FORMAT' for idk ' Qdensmin=' miqe ' Qdensmed=' meqe ' Qdensmax=' maqe ;
'FINS' ;
*
nctelem = 'NBEL' curtopo ;
nctno   = 'NBNO' curtopo ;
*
sc = 'SOUC' ;
'SI' sc ;
   nsouckas = nsouckas '+' 1 ;
   nsoucbas = nsoucbas '+' 1 ;
   lcaserr = lcaserr 'ET' ikas ;
'FINS' ;
lcvg = tparam . 'cvg' ;
'SI' ('NON' lcvg) ;
   ncvgkas = ncvgkas '+' 1 ;
   ncvgbas = ncvgbas '+' 1 ;
   lcvgerr = lcvgerr 'ET' ikas ;
'FINS' ;
tloc . 'souci'     = sc ;
tloc . 'cvg'       = cvg ;
tloc . 'tstelem'   = nctelem ;
tloc . 'tstnoeu'   = nctno   ;
tloc . 'tstparcou' = tparam . 'nparcou' ;
tloc . 'tstexplor' = tparam . 'nexplor' ;
tloc . 'tstchange' = tparam . 'nchange' ;
*
tloc . 'tstdvol'   = tparam . 'dvol' ;
tloc . 'tstnnul'   = tparam . 'nnul' ;
tloc . 'tstmiq'    = tparam . 'miq' ;
tloc . 'tstmaq'    = tparam . 'maq' ;
tloc . 'tstmeq'    = tparam . 'meq' ;
*
tibas . 'lcaserr' = lcaserr ;
tibas . 'lcvgerr' = lcvgerr ;
* Fin de la boucle sur les cas
'FIN' bkas ;
 
'SI' ('>' nsouckas 0) ;
   'MESS' '!!!! Il y a' ' ' nsouckas  ' /' ' ' nkas ' cas en erreur dans la base' ' ' nombase ' :' ;
   txt = ' ' ;
   'REPE' iierr ('DIME' lcaserr) ;
      ierr = &iierr ;
      icas = 'EXTR' lcaserr ierr ;
      idk = tikas . icas . 'idk' ;
      txt = 'CHAI' txt ' ' '(' icas ' ' idk ')' ;
   'FIN' iierr ;
   'MESS' txt ;
'SINO' ;
   'MESS' 'Aucun cas en erreur dans la base' ' ' nombase '. Bravo !' ;
'FINS' ;
*
'SI' ('>' ncvgkas 0) ;
   'MESS' '!!! Il y a' ' ' ncvgkas  ' /' ' ' nkas ' cas en non-convergence dans la base' ' ' nombase ;
   txt = ' ' ;
   'REPE' iierr ('DIME' lcvgerr) ;
      ierr = &iierr ;
      icas = 'EXTR' lcvgerr ierr ;
      idk = tikas . icas . 'idk' ;
      txt = 'CHAI' txt ' ' '(' icas ' ' idk ')' ;
   'FIN' iierr ;
   'MESS' txt ;
'SINO' ;
   'MESS' 'Aucun cas en non-convergence dans la base' ' ' nombase '. Bravo !' ;
'FINS' ;
*
* Sauvegarde éventuelle
*
*'OPTI' echo 1 ;
*
*'SI' lsauv ;
*   'TEMP' 'IMPR' 'SOMM' 'CPU' ;
   'SAUTER' 1 'LIGNE' ;
*   'TEMP' 'PLAC' ;
*   'SAUTER' 1 'LIGNE' ;
*'FINS' ;
*
'SI' lgentest ;
   'SI' lsauv ;
      nomfic   = 'CHAI' 'sauv/' nombase '_' (mydate) '.sauv' ;
      'MESS' ('CHAI' 'Saving ' nomfic) ;
      'OPTI' 'SAUV' nomfic ;
      lgg1 = lgentest ; lgg2 = lsauv ; lgg3 = nombase ;
      lgg4 = nomdate ; lgg5 = nomfic ;
      'OUBL' lgentest ; 'OUBL' lsauv ; 'OUBL' nombase ;
      'OUBL' nomdate ; 'OUBL' nomfic ;
      'SAUV' tikas ;
      lgentest = lgg1 ; lsauv = lgg2 ; nombase = lgg3 ;
      nomdate = lgg4 ; nomfic = lgg5 ;
   'FINS' ;
*
* Etape de test
*
'SINO' ;
   tikasn = tikas ;
   nomfic   = 'CHAI' 'sauv/' nombase '_' nomdate '.sauv' ;
   'MESS' ('CHAI' 'Loading ' nomfic) ;
   'OPTI' 'REST' nomfic ;
   lgg6 = debug ; lgg7 = test ;
   'REST' ;
   debug = lgg6 ; test = lgg7 ;
*
   nkasn = 'DIME' tikasn ;
   nkas = 'DIME' tikas ;
*tst   nkasn = 1 ; nkas = 1 ;
   'SI' ('NEG' nkas nkasn) ;
      cherr = 'CHAI' 'Les tables a comparer nont pas meme dimension ?' ;
      'ERRE' cherr ;
   'FINS' ;
   lidglob = vrai ;
   lokglob = vrai ;
   'REPE' bkas nkas ;
      ikas = &bkas ;
*tst      ikas = 3 ;
*      'MESS' ('CHAI' 'Numero du cas : ' ikas ' / ' nkas) ;
      chcas = 'CHAI' 'Numero du cas : ' ikas ' / ' nkas ;
      tlocn = tikasn . ikas ;
      tloc  = tikas  . ikas ;
      idkn  = tlocn . 'idk' ;
      idk   = tloc . 'idk' ;
      'SI' ('NEG' idkn idk) ;
         cherr = 'CHAI' chcas ' '
            'Les cas a comparer sont differents ? : ' idk ' ' idkn ;
         'ERRE' cherr ;
      'FINS' ;
      vsouci   = tloc . 'souci' ;
      vcvg     = tloc . 'cvg' ;
      vnctelem = tloc . 'tstelem' ;
      vnctno   = tloc . 'tstnoeu' ;
      vnparcou = tloc . 'tstparcou' ;
      vnexplor = tloc . 'tstexplor' ;
      vnchange = tloc . 'tstchange' ;
      souci = tlocn . 'souci' ;
      nctelem = tlocn . 'tstelem' ;
      nctno   = tlocn . 'tstnoeu' ;
      nparcou = tlocn . 'tstparcou' ;
      nexplor = tlocn . 'tstexplor' ;
      nchange = tlocn . 'tstchange' ;
*
* 2017/12/04 Petite tolérance sur les nombres de configuration
*
      ntol=1 ;
 
      lid = vrai ;
      lid = lid 'ET' ('EGA' vsouci souci) ;
      lid = lid 'ET' ('EGA' vnctelem nctelem) ;
      lid = lid 'ET' ('EGA' vnctno   nctno) ;
      lid = lid 'ET' ('EGA' vnparcou nparcou) ;
      lid = lid 'ET' ('EGA' vnexplor nexplor) ;
      lid = lid 'ET' ('EGA' vnchange nchange) ;
      lok = vrai ;
      lok = lok 'ET' ('OU' ('EGA' vsouci souci) vsouci) ;
      lok = lok 'ET' ('EGA' vnctelem nctelem) ;
      lok = lok 'ET' ('EGA' vnctno   nctno) ;
      lok = lok 'ET' ('>EG' vnparcou ('-' nparcou ntol)) ;
      lok = lok 'ET' ('>EG' vnexplor ('-' nexplor ntol)) ;
*      lok = lok 'ET' ('EGA' vnchange nchange) ;
      lok = lok 'ET' ('>EG' vnchange ('-' nchange ntol)) ;
* 2eme partie des tests ajoutés après le 28/08/2017
      ltest2 = 'EXIS' tloc 'tstdvol' ;
      'SI' ltest2 ;
*         'MESS' '2eme partie des tests effectuee' ;
         vdvol  = tloc . 'tstdvol' ;
         vnnul  = tloc . 'tstnnul' ;
         vmiq   = tloc . 'tstmiq'  ;
         vmaq   = tloc . 'tstmaq'  ;
         vmeq   = tloc . 'tstmeq'  ;
         dvol  = tlocn . 'tstdvol' ;
         nnul  = tlocn . 'tstnnul' ;
         miq   = tlocn . 'tstmiq'  ;
         maq   = tlocn . 'tstmaq'  ;
         meq   = tlocn . 'tstmeq'  ;
*2017/12/04 On n'essaie pas de faire mieux que la tolérance par défaut
*           sur la qualité et le volume
         votol = 1.D-11 ;
         qutol = 1.D-2 ;
*tst      vmiq = vmiq '+' 1.D-10 ;
         lid = lid 'ET' ('EGA' vdvol dvol votol) ;
         lid = lid 'ET' ('EGA' vnnul nnul) ;
         lid = lid 'ET' ('EGA' vmiq miq qutol) ;
         lid = lid 'ET' ('EGA' vmaq maq qutol) ;
         lid = lid 'ET' ('EGA' vmeq meq qutol) ;
*
         lok = lok 'ET' ('EGA' vdvol dvol votol) ;
         lok = lok 'ET' ('EGA' vnnul nnul) ;
         lok = lok 'ET' ('&lt;EG' ('-' vmiq qutol) miq) ;
         lok = lok 'ET' ('&lt;EG' ('-' vmaq qutol) maq) ;
         lok = lok 'ET' ('&lt;EG' ('-' vmeq qutol) meq) ;
      'SINO' ;
         'MESS'
         '!! ' chcas
         ' Attention, on na pas fait la 2eme partie des tests';
      'FINS' ;
 
      lidglob = lidglob 'ET' lid ;
      lokglob = lokglob 'ET' lok ;
 
      'SI' ('OU' ('NON' lid) ('NON' lok)) ;
         'SI' ('NON' lok) ;
            ch = 'CHAI' 'Cas ' idk ' incorrect, on a :' ;
         'SINO' ;
            ch = 'CHAI' 'Cas ' idk ' ameliore,  on a :' ;
         'FINS' ;
         'MESS' chcas ' ' ch ;
         tit = 'CHAINE' 'nbel=' nctelem ' ; nbno=' nctno ;
         'MESS' tit ;
         titt = 'CHAINE' 'Topologie: parcourues=' nparcou
                         ' examinees=' nexplor
                         ' changees=' nchange ;
         'MESSAGE' titt ;
         'SI' ltest2 ;
            titq = 'CHAINE' 'FORMAT' for
                         ' Dvol=' dvol ' NelV0=' nnul
                         '  Qmin=' miq ' Qmax=' maq ' Qmed=' meq ;
            'MESS' titq ;
         'FINS' ;
         ch = 'CHAI' 'Cas ' idk '           la reference etait :' ;
         'MESS' ch ;
         tit = 'CHAINE' 'nbel=' vnctelem ' ; nbno=' vnctno ;
         'MESS' tit ;
         titt = 'CHAINE' 'Topologie: parcourues=' vnparcou
                         ' examinees=' vnexplor
                         ' changees=' vnchange ;
         'MESSAGE' titt ;
         'SI' ltest2 ;
            titq = 'CHAINE' 'FORMAT' for
                         ' Dvol=' vdvol ' NelV0=' vnnul
                         '  Qmin=' vmiq ' Qmax=' vmaq ' Qmed=' vmeq ;
            'MESS' titq ;
         'FINS' ;
         ch = 'CHAI' 'Cas ' idk '           difference :' ;
         'MESS' ch ;
         tit = 'CHAINE' 'dnbe=' ('-' nctelem vnctelem)
                        ' ; dnbn=' ('-' nctno vnctno) ;
         'MESS' tit ;
         titt = 'CHAINE' 'Topologie: parcourues=' ('-' nparcou vnparcou)
                         ' examinees=' ('-' nexplor vnexplor)
                         ' changees=' ('-' nchange vnchange) ;
         'MESSAGE' titt ;
         'SI' ltest2 ;
            titdq = 'CHAINE' 'FORMAT' for
                         ' DDvo=' ('-' dvol vdvol)
                         ' DQmi=' ('-' miq  vmiq)
                         ' DQma=' ('-' maq  vmaq)
                         ' DQme=' ('-' meq  vmeq) ;
            'MESS' titdq ;
         'FINS' ;
*      'ERRE' 'stop' ;
         'SI' ('NON' lok) ;
            'MESS' '!!!!! CHECKME' ;
         'SINO' ;
            'MESS' '!!!!! Nouvelle reference' ;
         'FINS' ;
      'SINO' ;
         'MESS' chcas ' Ok' ;
      'FINS' ;
*      'SAUT' 1 'LIGNE' ;
   'FIN' bkas ;
*
   'SI' lokglob ;
      'MESSAGE' ('CHAINE' 'Tout sest bien passe...') ;
      'SI' ('NON' lidglob) ;
         'MESSAGE' ('CHAINE' '...avec des ameliorations.') ;
      'SINO' ;
         'MESSAGE' ('CHAINE' '...resultats identiques a la ref.') ;
      'FINS' ;
   'SINO' ;
      'SI' lidglob ;
         'MESS' '!!!!! Ce cas est impossible, verifiez le programme' ;
      'FINS' ;
      'OPTI' 'ECHO' 1 ;
      'ERRE' 'Il y a eu des regressions !!' ;
   'SINON' ;
      'SAUT' 1 'LIGN' ;
      'MESSAGE' ('CHAINE' 'Tout sest bien passe !') ;
   'FINSI' ;
'FINS' ;
*
 
'FIN' bclbas ;
'SI' ('>' nsoucbas 0) ;
   'MESS' '!!!!! Il y a au total' ' ' nsoucbas  ' cas en erreur dans les bases' ;
   txt = ' ' ;
   'REPE' iibas ('DIME' tbas) ;
      ibas = &iibas ;
      tibas = tbas . ibas ;
      lcaserr = tibas . 'lcaserr' ;
      tikas = tibas . 'tikas' ;
      'REPE' iierr ('DIME' lcaserr) ;
         ierr = &iierr ;
         icas = 'EXTR' lcaserr ierr ;
         idk = tikas . icas . 'idk' ;
         txt = 'CHAI' txt ' ' '(' ibas ',' icas ' ' idk ')' ;
      'FIN' iierr ;
   'FIN' iibas ;
   'MESS' txt ;
'SINO' ;
   'MESSAGE' 'Aucun cas en erreur dans la base. Bravo !' ;
'FINS' ;
'SI' ('>' ncvgbas 0) ;
   'MESS' '!!!! Il y a au total' ' ' ncvgbas  ' cas en non-convergence dans les bases' ;
   txt = ' ' ;
   'REPE' iibas ('DIME' tbas) ;
      ibas = &iibas ;
      tibas = tbas . ibas ;
      lcvgerr = tibas . 'lcvgerr' ;
      tikas = tibas . 'tikas' ;
      'REPE' iierr ('DIME' lcvgerr) ;
         ierr = &iierr ;
         icas = 'EXTR' lcvgerr ierr ;
         idk = tikas . icas . 'idk' ;
         txt = 'CHAI' txt ' ' '(' ibas ',' icas ' ' idk ')' ;
      'FIN' iierr ;
   'FIN' iibas ;
   'MESS' txt ;
'SINO' ;
   'MESSAGE' 'Aucun cas en non-convergence dans la base. Bravo !' ;
'FINS' ;
*
* Test au 2025/11/10
*
lok = vrai ;
'REPE' bclbas ('DIME' tbas) ;
   lokb = vrai ;
   ibas = &bclbas ;
   tibas = tbas . ibas ;
   nombase = tibas . 'nombase' ;
   lkerrref = tibas . 'lkerrref' ;
   lcaserr  = tibas . 'lcaserr' ;
   dlkr = 'DIME' lkerrref ;
   dlk  = 'DIME' lcaserr ;
   'SI' ('NEG' dlk dlkr) ;
      lokb = lokb 'ET' faux ;
      'MESS' '!!! Base' ' ' nombase ' : pas le meme nombre de cas en erreur' ;
   'SINO' ;
      ddlk = 'MAXI' ('-' lkerrref lcaserr) 'ABS' ;
      'SI' ('NEG' ddlk 0) ;
         lokb = lokb 'ET' faux ;
         'MESS' '!!! Base' ' ' nombase ' : pas les memes cas en erreur' ;
      'FINS' ;
   'FINS' ;
   'SI' ('NON' lokb) ;
      'MESS' '       Courant   :' ; 'LIST' lcaserr ;
      'MESS' '       Reference :' ; 'LIST' lkerrref ;
   'FINS' ;
   lok = lok 'ET' lokb ;
*
   lokc = vrai ;
   lcvgrref = tibas . 'lcvgrref' ;
   lcvgerr  = tibas . 'lcvgerr' ;
   dlkr = 'DIME' lcvgrref ;
   dlk  = 'DIME' lcvgerr ;
   'SI' ('NEG' dlk dlkr) ;
      lokc = lokc 'ET' faux ;
      'MESS' '!! Base' ' ' nombase ' : pas le meme nombre de cas en non-convergence' ;
   'SINO' ;
      ddlk = 'MAXI' ('-' lcvgrref lcvgerr) 'ABS' ;
      'SI' ('NEG' ddlk 0) ;
         lokc = lokc 'ET' faux ;
         'MESS' '!! Base' ' ' nombase ' : pas les memes cas en non-convergence' ;
      'FINS' ;
   'FINS' ;
   'SI' ('NON' lokc) ;
      'MESS' '       Courant   :' ; 'LIST' lcvgerr ;
      'MESS' '       Reference :' ; 'LIST' lcvgrref ;
   'FINS' ;
   lok = lok 'ET' lokc ;
'FIN' bclbas ;
*
'SI' ('NON' lok) ;
   'MESSAGE' ('CHAINE' '!!! Il y a eu des erreurs') ;
'SINON' ;
   'MESSAGE' ('CHAINE' 'Tout sest bien passe !') ;
'FINSI' ;
*
'OPTI' echo 1 ;
'SI' interact ;
   'OPTI' 'DONN'  5 ;
'FINS' ;
'SI' ('NON' lok) ;
   'ERRE' 5 ;
'FINS' ;
*
* End of dgibi file MAILTOPO
*
'FIN' ;