Télécharger g_theta.procedur

Retour à la liste

* G_THETA   PROCEDUR  JB251061  20/11/04    21:17:46     10763          
DEBPROC G_THETA SUPTAB*'TABLE' ;
*|=====================================================================|
*|                                                                     |
*|    OBJECTIF :                                                       |
*|    ==========                                                       |
*|                                                                     |
*| 1) calculer l'integrale caracteristique de mecanique de la rupture  |
*|    a) J en elasto-plasticite ou en elasto-dynamique pour un         |
*|       materiau isotrope.                                            |
*|    b) dJ/da en elasto-plasticite, utilisable uniquement dans le cas |
*|       de materiau isotrope et homogene pour les elements massifs.   |
*|    c) C* dans le cas de fluage secondaire stationnaire pour un      |
*|       materiau isotrope.                                            |
*|    d) C*H dans le cas de fluage primaire sous un chargement radial  |
*|       pour un materiau isotrope.                                    |
*|                                                                     |
*| 2) separer les modes K1, K2 et K3 en elasticite, utilisable         |
*|    uniquement dans le cas de materiau homogene et isotrope          |
*|    pour les elements massifs.                                       |
*|                                                                     |
*|                                                                     |
*|    ENTREE :                                                         |
*|    ========                                                         |
*|                                                                     |
*| SUPTAB  objet de type TABLE. En entree, SUPTAB sert a definir les   |
*|         options et les parametres du calcul. Ses indices sont des   |
*|         objets de type MOTS (a ecrire en toutes lettres) dont voici |
*|         la liste :                                                  |
*|                                                                     |
*|                                                                     |
*|    Arguments obligatoires dans tous les cas                         |
*|    ----------------------------------------                         |
*|                                                                     |
*| SUPTAB.'OBJECTIF' = MOT pour preciser le but du calcul, vaut        |
*|                     1) 'J' pour calculer l'integrale J (ou G),      |
*|                         caracteristique en elasto-plastique.        |
*|                     2) 'J_DYNA' pour calculer l'integrale J (ou G), |
*|                         caracteristique en elasto-dynamique.        |
*|                     3) 'C*' pour calculer l'integrale C*,           |
*|                         caracteristique en fluage secondaire        |
*|                         stationnaire.                               |
*|                     4) 'C*H' pour calculer l'integrale C*(h),       |
*|                         caracteristique en fluage primaire ou       |
*|                         tertiaire.                                  |
*|                     5) 'DJ/DA' pour calculer l'integrale de la      |
*|                         derivation dJ/da, caracteristique pour      |
*|                         analyser la stabilite de propagation d'une  |
*|                         fissure ou des fissures interagissantes.    |
*|                     6) 'DECOUPLAGE' pour decouper les modes mixtes, |
*|                         c'est a dire la separation des facteurs K1, |
*|                         K2 (et K3 et 3D).                           |
*|                                                                     |
*| SUPTAB.'COUCHE' = ENTIER representant le nombre de couches          |
*|                   d'elements autour du front de la fissure          |
*|                   qui se deplacent pour simuler la propagtion       |
*|                   de la fissure. Il vaut 0 si seul la pointe de     |
*|                   la fissure se deplace, 1 si c'est la premiere     |
*|                   couche d'elements entourant la fissure, 2 si      |
*|                   c'est l'ensemble des premiere et deuxieme couches |
*|                   d'elements etc. Il convient veiller a ce que      |
*|                   l'ensemble des elements a deplacer n'atteint pas  |
*|                   le bord de la structure fissuree.                 |
*|                   Si COUCHE et CHAMP_THETA sont tous deux donnés,   |
*|                   CHAMP_THETA est écrasé (cf.8.)                    |
*|                                                                     |
*| SUPTAB.'FRONT_FISSURE' = POINT en 2D ou MAILLAGE en 3D massif       |
*|                          representant le front de la fissure.       |
*|                                                                     |
*|                                                                     |
*|    Arguments obligatoires avec des elements standards               |
*|    --------------------------------------------------               |
*|                                                                     |
*| SUPTAB.'LEVRE_SUPERIEURE' = Selon la convention de definition, cet  |
*|                             objet (type MAILLAGE) representant la   |
*|                             levre superieure de la fissure.         |
*|                                                                     |
*| SUPTAB.'LEVRE_INFERIEURE' = Selon la convention de definition, cet  |
*|                             objet (type MAILLAGE) representant la   |
*|                             la levre inferieure de la fissure. Si   |
*|                             une seule levre est modelisee, un des   |
*|                             des deux mots ici (LEVRE_SUPERIEURE ou  |
*|                             LEVRE_INFERIEURE) sera suffisant pour   |
*|                             decrire la fissure.                     |
*|                                                                     |
*|                                                                     |
*|    Arguments obligatoires avec des elements enrichis (XFEM)         |
*|    --------------------------------------------------------         |
*|                                                                     |
*| SUPTAB.'PSI' =   1ere level set (CHPOINT) decrivant la fissure dans |
*|                  le cas ou l'on utilise des elements XFEM .         |
*| SUPTAB.'PHI' =   2eme level set.                                    |
*|                                                                     |
*|                                                                     |
*|                                                                     |
*|    Solution obligatoire issus de la procedure PASAPAS               |
*|    --------------------------------------------------               |
*|                                                                     |
*| SUPTAB.'SOLUTION_PASAPAS' = TABLE sortant de la procedure PASAPAS.  |
*|                                                                     |
*|                                                                     |
*|    Solution obligatoire issus de l'operateur RESO                   |
*|    ----------------------------------------------                   |
*|                                                                     |
*| SUPTAB.'SOLUTION_RESO' = CHPOINT de deplacement issus de RESO.      |
*| SUPTAB.'CARACTERISTIQUES' = Champ de caractristiques matrielles     |
*|                             et eventuellement geometriques          |
*|                             si necessaire.                          |
*| SUPTAB.'MODELE' = Objet modele (type MMODEL) englobant toute la     |
*|                   structure.                                        |
*| SUPTAB.'TEMPERATURES' = CHPOINT de temperature creant une contrainte|
*|                         thermique non nulle si elle existe.         |
*| SUPTAB.'CHARGEMENTS_MECANIQUES' = CHPOINT representant l'ensemble   |
*|                                   des forces exterieures            |
*|                                   (surfaciques, volumiques ou       |
*|                                   ponctuelles ....) appliquees sur  |
*|                                   le systeme si elles existent, SAUF|
*|                                   la pression sur les levres de la  |
*|                                   fissure                           |
*| SUPTAB.'BLOCAGES_MECANIQUES' = RIGIDITE representant le blocages    |
*|                                mecanique du probleme, a fournir     |
*|                                uniquement dans le cas de calcul     |
*|                                de la derivation dJ/da.              |
*|                                                                     |
*|                                                                     |
*|    Arguments optionnels                                             |
*|    --------------------                                             |
*|                                                                     |
*|                                                                     |
*|    1 : Materiaux composites (2D massif ou 3D coque seulement)       |
*|                                                                     |
*| SUPTAB.'MODELES_COMPOSITES' = TABLE indicee par des entiers (1 2... |
*|                               M, M = nombre de Materiaux composites)|
*|                               pour donner les modeles des materiaux |
*|                               ayant des discontinutes de proprietes |
*|                               materielles.                          |
*|                                                                     |
*|    2 : Pour un front de fissure tridimensionnel massif              |
*|                                                                     |
*| SUPTAB.'NOEUDS_AVANCES' = MAILLAGE de type POI1 pour donner les     |
*|                           points du front pour lesquels le calcul   |
*|                           sera effectue. Si cet argument est        |
*|                           obsent, le calcul sera fait pour tous     |
*|                           les noeuds sur le front de la fissure.    |
*|                                                                     |
*|    3 : Calcul des termes croises de la matrice dJi/daj              |
*|        (i non egal a j) dans le cas des fisures interagissantes.    |
*|                                                                     |
*| SUPTAB.'FISSURE_2' = Objet de type MAILLAGE representant une autre  |
*|                      fissure (levres superieure + inferieure si     |
*|                      toutes les deux levres sont presentes).        |
*| SUPTAB.'FRONT_FISSURE_2' = POINT ou MAILLAGE reprsentant le front   |
*|                            de la fissure 2 decrite ci-dessus.       |
*|                                                                     |
*|                                                                     |
*|    4 : Cas d'une fissure circulaire dans une geometrie plane        |
*|                                                                     |
*| SUPTAB.'POINT_CENTRE'  = centre de la fissure circulaire            |
*|                                                                     |
*|    5 : Cas ou l'extension de la fissure correspond a une simple     |
*|        translation dans un tuyauterie droite (3D). Dans ce cas      |
*|        on effectue dans la procedure CH_THETA une transformation    |
*|        de tuyau en plaque en passant au systeme de coordonnees      |
*|        cylindriques. Il est alors necessaire de fournir :           |
*|                                                                     |
*| SUPTAB.'POINT_1' = centre du systeme de coordonnees                 |
*| SUPTAB.'POINT_2' = POINT tel que l'axe defini par POINT_1           |
*|                    vers POINT_2 soit l'axe Z poisitif               |
*| SUPTAB.'POINT_3' = POINT tel que le plan defini par les 3 points    |
*|                    POINT_1 POINT_2 POINT_3 donne l'angle theta nul  |
*|                                                                     |
*|    6 : Cas ou l'extension de la fissure ne correspond               |
*|        pas a une simple translation (3D)                            |
*|                                                                     |
*|      6.1 Fissure dans un tuyauterie droite (3D, Rotation)           |
*|                                                                     |
*| SUPTAB.'POINT_1' = Objet de type POINT                              |
*| SUPTAB.'POINT_2' = Objet de type POINT qui, avec le point POINT_1,  |
*|                    constitue l'axe perpendiculaire a la section     |
*|                    fissuree.                                        |
*|                                                                     |
*|      6.2 Fissure dans un coude (3D, rotation + transformation)      |
*|          Outre les deux points SUPTAB.'POINT_1' et SUPTAB.'POINT_2' |
*|          definis en haut on donne encore :                          |
*|                                                                     |
*| SUPTAB.'CHPOINT_TRANSFORMATION' = Objet de type CHPOINT utilise     |
*|                                   pour transformer une coude en un  |
*|                                   tuyauterie droite.                |
*| SUPTAB.'OPERATEUR' = Objet de type MOT valant 'PLUS' ou 'MOIN' pour |
*|                      indiquer l'operateur PLUS ou MOIN a utiliser   |
*|                      si l'on veut transformer la coude en un        |
*|                      tuyauterie droite.                             |
*|                                                                     |
*|    7 : Rotation rigidifiante imposee dans le calcul par PASAPAS     |
*|                                                                     |
*| SUPTAB.'ROTATION_RIGIDIFIANTE' = table indicee par entiers 0,1,2... |
*|                                  donnant les champs de deplacements |
*|                                  due a une rotation rigidifiante de |
*|                                  la piece autour d'un point. Cette  |
*|                                  rotation rigidifiante est imposee  |
*|                                  dans le calcul par PASAPAS en tant |
*|                                  d'un calcul en grand deplacement.  |
*|                                                                     |
*|    8 : Cas ou on souhaite donner soi-meme le champ THETA            |
*|                                                                     |
*| SUPTAB.'CHAMP_THETA' = Objet de type CHPOINT caracterisant la       |
*|                        propagation de la fissure. Dans ce cas,      |
*|                        ne pas fournir l'indice 'COUCHE' de SUPTAB,  |
*|                        mais fournir 'CHAMP_THETA' a chaque appel.   |
*|                                                                     |
*|    9 : Cas ou on souhaite calculer une integrale dans l epaisseur   |
*|        d une structure en coque (rapport DMT/96-317)                |
*|                                                                     |
*|        On utilise pour cela la technique de multicouche, qui        |
*|        consiste, avant d'appeler la proceduer G_THETA, a :          |
*|        1) Etablir un modele multicouches (cf MODE CONS) sur un ou   |
*|           des element(s) proche(s) de la fissure sachant qu'il faut |
*|           au moins une couche en peau inferieure, une couche en     |
*|           peau superieure, une couche en ligne moyenne {ces couches |
*|           doivent avoir une epaisseur inferieure a 1e-4*(epaisseur  |
*|           totale de la coque) et donc 2 couches intermediaires.     |
*|        2) Penser a donner un excentrement et un nom constituant     |
*|           different a ces couches.                                  |
*|        3) Assembler le modele multicouches avec le modele du reste  |
*|           de la structure.                                          |
*|        4) Effectuer le calcul des contraintes et des deplacements   |
*|           avec le modele total et le materiau qui en decoule.       |
*|        Le calcul de l'integrale avec la procedure G_THETA sera      |
*|        realise sur un seul element en multicouche et pour toutes les|
*|        couches dans cet element qui ont une epaisseur inferieure a  |
*|        1e-4*(epaisseur totale de la coque). Un tel element doit     |
*|        etre designe par l'argument suivant :                        |
*|                                                                     |
*| SUPTAB.'ELEMENT_MULTICOUCHE' = Objet MAILLAGE comportant UN SEUL    |
*|                                element modelise en multicouche. Il  |
*|                                doit etre a l'interieur de la zone   |
*|                                THETA, c'est a dire dans la zone     |
*|                                definie par le nombre SUPTAB.'COUCHE'.
*|                                Il ne doit pas etre trop loin, ni    |
*|                                trop proche de la pointe de la       |
*|                                fissure. Theoriquement, l'integrale  |
*|                                a calculer est independant du choix  |
*|                                de l'element pres de la fissure, ce  |
*|                                qui est numeriquement verifiable en  |
*|                                la determinant sur des elemens en    |
*|                                multicouche differents. NOTA : Cette |
*|                                technique necessite un maillage tres |
*|                                fin dans la zone de la pointe de la  |
*|                                fissure.                             |
*|                                                                     |
*|                                                                     |
*|    SORTIE :                                                         |
*|    ========                                                         |
*|                                                                     |
*| Les resultats du calcul correspondant a un champ THETA specifie par |
*| l'objet SUPTAB.'COUCHE' (ou SUPTAB.'CHAMP_THETA' dans le cas ou on  |
*| souhaite donner soi-meme un champ de type Theta) sont sauves de la  |
*| maniere suivante :                                                  |
*|                                                                     |
*|                                                                     |
*|    Dans tous les cas de calcul                                      |
*|    ---------------------------                                      |
*|                                                                     |
*| SUPTAB.'RESULTATS' = Objet contenant la valeur numerique du calcul. |
*|                      Son type est variable selon qu'on est en 2D ou |
*|                      3D et selon la solution du probleme traite :   |
*|                                                                     |
*|                      1) valeur de l'integrale de contour dans le cas|
*|                         d'une solution provenant de l'operateur RESO|
*|                         2D        => FLOTTANT                       |
*|                         3D massif => TABLE indicee par              |
*|                            .(points au front de fissure)            |
*|                            .'GLOBAL' pour une estimation globale    |
*|                         3D coque  => TABLE indicee par mots         |
*|                            .'SUPERI' en peau superieure             |
*|                            .'INFERI' en peau inferieure             |
*|                            .'MEDIAN' au plan median et              |
*|                            .'GLOBAL' pour une estimation globale    |
*|                                                                     |
*|                      2) valeur de l'integrale de contour a un       |
*|                         certain pas du calcul dans le cas d'une     |
*|                         solution provenant de la procedure PASAPAS  |
*|                         2D        => TABLE indicee par              |
*|                            .(numero du pas de calcul)               |
*|                         3D massif => TABLE indicees par             |
*|                            .(numero du pas de calcul).(points au    |
*|                              front de fissure)                      |
*|                         3D coque  => TABLE indicees                 |
*|                            .(numero du pas de calcul).'SUPERI'      |
*|                            .(numero du pas de calcul).'INFERI'      |
*|                            .(numero du pas de calcul).'MEDIAN' et   |
*|                            .(numero du pas de calcul).'GLOBAL'      |
*|                                                                     |
*|                      3) valeur des F.I.C. (facteurs d'intensite des |
*|                         contraintes) dans le cas de decouplage des  |
*|                         modes avec une solution provenant de        |
*|                         l'operateur RESO                            |
*|                         2D        => TABLE indicee par mots         |
*|                            .'I'  pour KI                            |
*|                            .'II' pour KII                           |
*|                         3D massif => TABLE indicees par             |
*|                            .'I'  .(points au front de fissure)      |
*|                              pour KI                                |
*|                            .'II' .(points au front de fissure)      |
*|                              pour KII                               |
*|                            .'III'.(points au front de fissure)      |
*|                              pour KIII et                           |
*|                            .'GLOBAL'.(points au front de fissure)   |
*|                                                                     |
*|                      4) valeur des F.I.C. (facteurs d'intensite des |
*|                         contraintes) a un certain pas du calcul     |
*|                         dans le cas de decouplage des modes avec    |
*|                         une solution provenant de la procedure      |
*|                         PASAPAS                                     |
*|                         2D        => TABLE indicees                 |
*|                            .'I' .(numero du pas de calcul) pour KI  |
*|                            .'II'.(numero du pas de calcul) pour KII |
*|                         3D massif => TABLE indicees par             |
*|                            .'I'  .(numero du pas de calcul).(point  |
*|                              au front de fissure) pour KI           |
*|                            .'II' .(numero du pas de calcul).(points |
*|                              au front de fissure) pour KII          |
*|                            .'III'.(numero du pas de calcul).(points |
*|                              au front de fissure) pour KIII         |
*|                                                                     |
*|                                                                     |
*|    Dans le cas de calcul effectue pas a pas                         |
*|    ----------------------------------------                         |
*|                                                                     |
*| SUPTAB.'EVOLUTION_RESULTATS' = Objet contenant l'evolution des      |
*|                                resultats en fonction du temps.      |
*|                                Son type est variable selon la       |
*|                                configuration du probleme traite :   |
*|                                                                     |
*|                             1) Evolution de l'integrale de contour  |
*|                                2D        => EVOLUTION               |
*|                                3D massif => TABLE indicee par       |
*|                                   .(points au front de fissure)     |
*|                                   .'GLOBAL' evolution pour une      |
*|                                     estimation globale              |
*|                                3D coque  => TABLE indicee par MOTS  |
*|                                   .'SUPERI' en peau superieure      |
*|                                   .'INFERI' en peau inferieure      |
*|                                   .'MEDIAN' au plan median et       |
*|                                   .'GLOBAL' evolution pour une      |
*|                                     estimation globale              |
*|                                                                     |
*|                             2) Evolution des F.I.C. (facteurs       |
*|                                d'intensite de contrainte)           |
*|                                2D        => TABLE indicee par       |
*|                                   .'I'  pour KI                     |
*|                                   .'II' pour KII                    |
*|                                3D massif => TABLE indicee par       |
*|                                   .'I'.  (points au front de fissure)
*|                                   .'II'. (points au front de fissure)
*|                                   .'III'.(points au front de fissure)
*|                                   .'GLOBAL' evolution pour une      |
*|                                     estimation globale              |
*|                                                                     |
*|                                                                     |
*|    Dans le cas des elements de coque                                |
*|    ---------------------------------                                |
*|                                                                     |
*| SUPTAB.'EPAISSEUR_RESULTATS' = representant l'evolution de la valeur|
*|                                des integrales dans l'epaisseur de la|
*|                                coque. Son type est variable selon la|
*|                                solution du probleme traite :        |
*|                             1) EVOLUTION dans le cas d'une solution |
*|                                provenant de l'operateur RESO        |
*|                             2) TABLE indicee par .(numero du pas de |
*|                                calcul) dans le cas d'une solution   |
*|                                provenant de la procedure PASAPAS    |
*|                                                                     |
*|                                                                     |
*|    Dans le cas de calcul elasto-plastique                           |
*|    --------------------------------------                           |
*|                                                                     |
*| SUPTAB.'CRITERE_DECHARGE' = En cas de calcul elasto-plastique       |
*|         isotrope ou cinematique, eventuellement thermique, on       |
*|         calcul un critere de decharge des contraintes defini par    |
*|         (si, F = courbe de traction ): crit = F(EPSeq)/ SIGeq.      |
*|         crit = 1. si non-decharge et crit > 1. si decharge.         |
*|         SUPTAB.'CRITERE_DECHARGE' est une table indicee par les     |
*|         temps de calcul.                                            |
*|                                                                     |
*|                                                                     |
*|    Dans le cas du contact frottement sur les levres                 |
*|    --------------------------------------                           |
*|                                                                     |
*| A ce jour, cela est traite pour le cas xfem (these de B.Trolle).    |
*|                                                                     |
*|=====================================================================|
 
* INTRODUCTION DE VARIABLES UTILES
* --------------------------------
 
* CREATION DE LA TABLE DE BOOLEENS
* ********************************
 
BOOL = TABL ;
BOOL.'TRAC' = FAUX ;
BOOL.'MESS' = VRAI ;
SI BOOL.'MESS' ;
        SAUT 'LIGNE' ;
        MESS '------------------' 'DEBUT DE LA PROCEDURE G_THETA'
        '--------------------' ;
FINSI ;
SAUT 'LIGNE' ;
 
* CONFIGURATION INITIALE
* **********************
 
CONFIG0 = FORM ;
 
 
* =============================================================================
 
* DETERMINATION DU CAS DEMANDE ET VERIFICATION DES DONNEES OBLIGATOIRES
* ---------------------------------------------------------------------
 
* APPEL A G_CAS
* *************
 
OBJUTI = G_CAS SUPTAB BOOL ;
SI (EGA (TYPE OBJUTI) (MOT 'ANNULE')) ;
        MESS 'ERREUR : IL Y A EU UN PROBLEME INATTENDU PENDANT LA LECTURE DES' ;
        MESS '         DONNEES' ;
        QUIT G_THETA ;
FINSI ;
 
 
* LECTURE DES DONNEES FOURNIES
* ****************************
 
GDIME = OBJUTI.'DIMENSION' ;
GMODE = OBJUTI.'MODE' ;
MOD_TOT = OBJUTI.'MOD_TOT' ;
MOD_MEC = OBJUTI.'MOD_MEC' ;
MAT_MEC = OBJUTI.'MAT_MEC' ;
SI BOOL.'PASAPAS' ;
        WTAB = OBJUTI.'WTAB' ;
FINSI ;
MAILLAGE = OBJUTI.'MAILLAGE' ;
M_FRONT = OBJUTI.'FRONT' ;
 
 
* QUELQUES DONNEES NON ISSUES DE G_CAS
* ************************************
 
* TYPE D'ELEMENTS DU MAILLAGE
LELEM1 = MAILLAGE ELEM 'TYPE' ;
 
SI BOOL.'MODE_PRES' ;
        MODCHA = EXTR MOD_TOT 'FORM' 'CHARGEMENT' ;
        MODPRE = EXTR MODCHA 'COMP' 'PRESSION' ;
        SI (NON BOOL.'PASAPAS') ;
                MATPRE = REDU (SUPTAB.'PRESSION') MODPRE ;
        FINSI ;
        MAILPTOT = EXTR MODPRE 'MAIL' ;
        MAILPF = INTE MAILPTOT (SUPTAB.'FISSURE') ;
FINSI ;
* VERIFICATIONS DANS LE CAS DE PERSO1
SI BOOL.'PERSO1' ;
        SI BOOL.'MESS' ;
                MESS 'utilisation de PERSO1 en cours de dvlpt' ;
        FINSI ;
        SI (EXIS SUPTAB.'SOLUTION_PASAPAS' 'ESTIMATION') ;
                ESTIM = SUPTAB.'SOLUTION_PASAPAS'.'ESTIMATION' ;
        SINON ;
                MESS 'ERREUR : il faut une ESTIMATION dans la SOLUTION_PASAPAS' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        SI (NON (EXIS SUPTAB 'MAILLAGE_REDUIT')) ;
                MESS 'Attention! utilisation de PERSO1 sans MAILLAGE_REDUIT' ;
                MESS 'uniquement valable dans le cas de fissure stationnaire' ;
        FINSI ;
FINSI ;
 
 
* MOTS DE COMPOSANTES UTILES
* **************************
 
* LISTMOT SCAL :
MTS1 = MOTS 'SCAL' ;
* LISTMOTS POUR LE DEPLACEMENT ET POUR LA FORCE :
* ON EXTRAIT LES GDIME PREMIERS MOTS CAR ON NE VEUT PAS DES ROTATIONS
* DANS LE CAS DES COQUES
MUI = EXTR (EXTR MOD_MEC 'DEPL') (LECT 1 PAS 1 GDIME) ;
MFI = EXTR (EXTR MOD_MEC 'FORC') (LECT 1 PAS 1 GDIME) ;
MU1 = EXTR MUI 1 ; MU2 = EXTR MUI 2 ; 
MF1 = EXTR MFI 1 ; MF2 = EXTR MFI 2 ;
SI (EGA GDIME 3) ;
        MF3 = EXTR MFI 3 ;
FINSI ;
 
 
* CREATION DE CHAR1 SI PASAPAS
* ****************************
 
SI BOOL.'PASAPAS' ;
        CHAR1 = SUPTAB.'SOLUTION_PASAPAS'.'CHARGEMENT' ;
FINSI ;
 
 
* DONNEES EN CAS DE CONTACT
* *************************
 
SI ((NON BOOL.'PASAPAS') ET BOOL.'FROT') ;
        OBJCON = SUPTAB.'MODELE_FISSURE' ;
        MAICON = EXTR OBJCON 'MAILLAGE' ;
FINSI ;
 
 
* =============================================================================
 
* EXTRACTION DU MAILLAGE, DU CHAMP THETA ET DE LA DIRECTION DE PROPAGATION
* ------------------------------------------------------------------------
 
* MODELE MULTICOUCHES DANS LE CAS DE COQUE
* ****************************************
 
SI BOOL.'COQ' ;
        M_DETA = EXTR MOD_MEC 'ZONE' ;
        SI (EXIS SUPTAB 'ELEMENT_MULTICOUCHE') ;
                ELMULT = SUPTAB.'ELEMENT_MULTICOUCHE' ;
                SI (NEG (TYPE ELMULT) 'MAILLAGE') ;
                        MESS 'ERREUR : L ELEMENT EN MULTICOUCHE DOIT' ;
                        MESS '         ETRE UN OBJET DE TYPE MAILLAGE' ;
                        ERRE 21 ; QUIT G_THETA ;
                FINSI ;
                SI (NEG (NBEL ELMULT) 1) ;
                        MESS 'ERREUR : ON VEUT UN SEUL ELEMENT EN MULTICOUCHE' ;
                        ERRE 21 ; QUIT G_THETA ;
                FINSI ;
        SINON ;
                MESS 'ERREUR : IL FAUT DESIGNER UN ELEMENT EN MULTICOUCHE' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        M_ELMU = EXTR (REDU MOD_MEC ELMULT) 'ZONE' ;
        SI ((DIME M_ELMU) '<' 10) ;
                MESS 'ERREUR : IL FAUT AU MOINS 3 COUCHES (peau inf, peau' ;
                MESS '         sup, ligne moyenne) D EPAISSEUR INFERIEURE' ;
                MESS '         A 1E-4*(EPAISSEUR TOTALE) + 2 COUCHES' ;
                MESS '         INTERMEDIAIRES POUR L ELEMENT DESIGNE EN' ;
                MESS '         MULTICOUCHE PROCHE DE LA FISSURE.' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        PEX1 = PROG ; LMO1 = LECT ; MODCOU = TABLE ; EPAITO = 0. ;
        REPE NBJ5 ((DIME M_ELMU)/2) ;
                I1 = (2 * &NBJ5) - 1 ;
                MODCOU.&NBJ5 = M_ELMU.I1 ;
                EX1 = EXTR (REDU MODCOU.&NBJ5 MAT_MEC) 'EXCE' 1 1 1 ;
                EP1 = EXTR (REDU MODCOU.&NBJ5 MAT_MEC) 'EPAI' 1 1 1 ;
                EPAITO = EPAITO + EP1 ;
                PEX1 = PEX1 ET (PROG EX1) ;
                LMO1 = LMO1 ET (LECT &NBJ5) ;
        FIN NBJ5 ;
        NSUPE = 0 ; NMOYE = 0 ; NINFE = 0 ;
        REPE NBJ6 (DIME MODCOU) ;
                EX1 = EXTR PEX1 &NBJ6 ;
                LM1 = EXTR LMO1 &NBJ6 ;
                SI (EGA EX1 (EPAITO/2.) 1.E-4) ;
                        NSUPE = LM1 ;
                FINSI ;
                SI (EGA EX1 0. 1.E-10) ;
                        NMOYE = LM1 ;
                FINSI ;
                SI (EGA EX1 (EPAITO/(-2.)) 1.E-4) ;
                        NINFE = LM1 ;
                FINSI ;
        FIN NBJ6 ;
        SI (EGA NSUPE 0) ;
                MESS 'ERREUR : IL FAUT UNE COUCHE EN PEAU SUPERIEURE' ;
                MESS '         D EPAISSEUR INFERIEURE A' ;
                MESS '         1E-4*(EPAISSEUR TOTALE) ' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        SI (EGA NMOYE 0) ;
                MESS 'ERREUR : IL FAUT UNE COUCHE AU PLAN MEDIAN' ;
                MESS '         AYANT UN EXCENTREMENT NUL' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        SI (EGA NINFE 0) ;
                MESS 'ERREUR : IL FAUT UNE COUCHE EN PEAU INFERIEURE' ;
                MESS '         D EPAISSEUR INFERIEURE A' ;
                MESS '         1E-4*(EPAISSEUR TOTALE) ' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        SUPTAB.'EPAISSEUR' = EPAITO ;
        M_SUPE = MODCOU.NSUPE ;
        M_MOYE = MODCOU.NMOYE ;
        M_INFE = MODCOU.NINFE ;
FINSI ;
 
 
* MAILLAGE UTILISE DANS LA RESOLUTION PAR E.F.
* ********************************************
 
SI BOOL.'COQ' ;
        TMULT = TABL ;
        REPE NBJ8 ((DIME M_DETA)/2) ;
                M1 = M_DETA.(2*&NBJ8) ;
                SI (EXIS TMULT M1) ;
                        ITER NBJ8 ;
                FINSI ;
                M2 = EXTR (REDU MOD_MEC M1) 'ZONE' ;
                SI (> (DIME M2) 2) ;
                        TMULT.M1 = VRAI ;
                        REPE NBJ9 (((DIME M2)/2) - 1) ;
                                MAILLAGE = DIFF MAILLAGE M1 ;
                        FIN NBJ9 ;
                FINSI ;
        FIN NBJ8 ;
FINSI ;
SUPTAB.'MAILLAGE' = MAILLAGE ;
 
 
* DETERMINATION DES CHAMPS THETA ET PI ET DE LA ZONE DE TRAVAIL ELTETA
* ********************************************************************
 
SI BOOL.'MESS' ;
        MESS 'DETERMINATION DES CHAMPS THETA' ;
FINSI ;
SI ((EXIS SUPTAB 'COUCHE') ET (EXIS SUPTAB 'CHAMP_THETA')) ;
*       COUCHE ET CHAMP_THETA TOUS LES DEUX DONNES
        MESS 'NOMBRE DE COUCHES DONNE => LE CHAMP_THETA FOURNI SERA ECRASE' ;
FINSI ;
* DETERMINATION DE CHAMP_THETA
SI (EXIS SUPTAB 'COUCHE') ;
*       NOMBRE DE COUCHE DONNE => ON APPELLE CH_TETX OU CH_TETA POUR CALCULER
*       CHAMP_THETA
*       SI CHAMP_THETA EST EGALEMENT FOURNI, IL EST ECRASE
        SI BOOL.'XFEM' ;
                SUPTAB.'CHAMP_THETA' SUPTAB.'UTILTET1' = CH_THETX SUPTAB ;
        SINON ;
                SUPTAB.'CHAMP_THETA' SUPTAB.'UTILTET1' = CH_THETA SUPTAB ;
                SI BOOL.'DJ/DA' ;
                        SI (NON (EXIS SUPTAB 'FRONT_FISSURE_2')) ;
                                SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') - 1 ;
                                SUPTAB.'CHAMP_PI' UTILPI = CH_THETA SUPTAB ;
                                SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') + 1 ;
                        SINON ;
                                P1 = SUPTAB.'FRONT_FISSURE' ;
                                SUPTAB.'FRONT_FISSURE' = SUPTAB.'FRONT_FISSURE_2' ;
                                SUPTAB.'FISSURE' = SUPTAB.'FISSURE_2' ;
                                SUPTAB.'CHAMP_PI' UTILPI = CH_THETA SUPTAB ;
                                SUPTAB.'FRONT_FISSURE' = P1 ;
                        FINSI ;
                FINSI ;
        FINSI ;
SINON ;
        MESS 'CHAMP_THETA FOURNI PAR L UTILISATEUR' ;
FINSI ;
CHTHETA = SUPTAB.'CHAMP_THETA' ;
SI (NEG (TYPE CHTHETA) 'CHPOINT') ;
        CHTHETA = CHTHETA.'GLOBAL' ;
FINSI ;
* DETERMINATION DE ELTETA
* ELTETA1 = MAILLAGE OU TETA N EST PAS NUL + 1 COUCHE
UU = EXTR CHTHETA 'MAILLAGE' ;
ELTETA1 = ELEM MAILLAGE 'APPU' 'LARG' UU ;
SI (EXIS SUPTAB 'MAILLAGE_REDUIT') ;
*       ELTETA = MAILLAGE FOURNI PAR L UTILISATEUR
        ELTETA = SUPTAB.'MAILLAGE_REDUIT' ;
*       VERIFICATION DE LA COMPATIBILITE AVEC CHTHETA
        SI ((NBEL (DIFF ELTETA ELTETA1)) NEG 0) ;
                MESS 'ATTENTION : LE MAILLAGE_REDUIT DONNE EST INCOMPATIBLE AVEC LE' ;
                MESS '            CHAMP THETA, IL SERA DONC IGNORE.' ;
                ELTETA = ELTETA1 ;
        FINSI ;
SINON ;
        ELTETA = ELTETA1 ;
FINSI ;
* DETERMINATION DE LA DIRECTION DE PROPAGATION ET DES NORMALES
SI BOOL.'XFEM' ;
*       ON EST DANS LE CAS XFEM
        MOD7 = MODE ELTETA 'THERMIQUE' ;
        GPSI = GRAD MOD7 (NOMC 'T' SUPTAB.'PSI' 'NATU' 'DIFFUS') ;
        GPSI = CHAN 'NOEUD' MOD7 GPSI 'SCALAIRE' ;
        GPHI = GRAD MOD7 (NOMC 'T' SUPTAB.'PHI' 'NATU' 'DIFFUS') ;
        GPHI = CHAN 'NOEUD' MOD7 GPHI 'SCALAIRE' ;
        NCOMP = EXTR GPSI 'COMP' ;
        SI (EGA GDIME 2) ;
*               LA DIRECTION DE PROPAGATION EST PERPENDICULAIRE A GRAD PHI ET DANS LE
*               MEME SENS QUE GRAD PSI => ON UTILISE UN PRODUIT VECTORIEL
*               ETAPE 1 : PROJECTION SUR LE FRONT DE FISSURE ET PASSAGE EN CHPO
                PGPSI = PROI M_FRONT GPSI ;
                PGPHI = PROI M_FRONT GPHI ;
*               ETAPE 2 : PRODUIT VECTORIEL AVEC LA NORMALE AU PLAN
*               NB : ON FAIT ATTENTION AU SENS DE TETA GRACE A SIGN
                TETA = PVEC PGPHI NCOMP MUI ;
                SIGN1 = SIGN (PSCA TETA PGPSI MUI NCOMP) ;
                TETA = SIGN1 * TETA ;
*               ETAPE 3 : NORMALISATION ET CALCUL DE DIR2               
                NTETA = (PSCA TETA TETA MUI MUI)**0.5 ;
                DIR1 = TETA / NTETA ;
                DIR2 = PVEC DIR1 MUI MUI ;
        SINON ;
*               PASSAGE DES DIRECTIONS EN CHPO ET PRODUITS VECTORIELS
                DIR1 = CHAN 'CHPO' MOD7 GPSI 'MOYE' ;
                DIR2 = CHAN 'CHPO' MOD7 GPHI 'MOYE' ;
                DIR3 = PVEC DIR1 NCOMP DIR2 NCOMP MUI ;
                DIR1 = PVEC DIR2 NCOMP DIR3 MUI MUI ;
*               NORMALISATION, INTERPOLATION PUIS RENORMALISATION :
*               POUR DIR1 ON FAIT ATTENTION CAR ON PEUT AVOIR UN POINT SINGULIER
                NDIR1 = (PSCA DIR1 DIR1 MUI MUI)**0.5 ;
                MASQ1 = MASQ NDIR1 'SUPERIEUR' 1.E-2 ;
                BORN1 = BORN NDIR1 'SCAL' 'MINIMUM' 1.E-2 ;
                DIR1 = CHAN 'ATTRIBUT' (DIR1 / BORN1 * MASQ1) 'NATURE' 'DIFFUS' ;
                V1 = DIR1 ;
                DIR1 = INT_COMP ELTETA DIR1 M_FRONT ;
                DIR1 = DIR1 / ((PSCA DIR1 DIR1 MUI MUI)**0.5) ;
*               POUR DIR2 PAS DE PROBLEME
                DIR2 = NOMC NCOMP MUI DIR2 ;
                NDIR2 = (PSCA DIR2 DIR2 MUI MUI)**0.5 ;
                DIR2 = CHAN 'ATTRIBUT' (DIR2 / NDIR2) 'NATURE' 'DIFFUS' ;
                V2 = DIR2 ;
                DIR2 = INT_COMP ELTETA DIR2 M_FRONT ;
                DIR2 = DIR2 / ((PSCA DIR2 DIR2 MUI MUI)**0.5) ;
*               POUR DIR3 ON FAIT ATTENTION CAR ON PEUT AVOIR UN POINT SINGULIER
                NDIR3 = (PSCA DIR3 DIR3 MUI MUI)**0.5 ;
                MASQ3 = MASQ NDIR3 'SUPERIEUR' 1.E-2 ;
                BORN3 = BORN NDIR3 'SCAL' 'MINIMUM' 1.E-2 ;
                DIR3 = CHAN 'ATTRIBUT' (DIR3 / BORN3 * MASQ3) 'NATURE' 'DIFFUS' ;
                V3 = DIR3 ;
                DIR3 = INT_COMP ELTETA DIR3 M_FRONT ;
                DIR3 = DIR3 / ((PSCA DIR3 DIR3 MUI MUI)**0.5) ;
        FINSI ;
SINON ;
*       ON EST DANS LE CAS STD
        DIR1 = REDU CHTHETA (SUPTAB.'FRONT_FISSURE') ;
        NDIR1 = (PSCA DIR1 DIR1 MUI MUI)**0.5 ;
        DIR1 = DIR1 / NDIR1 ;
        SI (NON BOOL.'COQ') ;
                SI (EXIS SUPTAB 'LEVRE_SUPERIEURE') ;
                        F1 = PRES 'MASS' MOD_MEC SUPTAB.'LEVRE_SUPERIEURE' 1. ;
                SINON ;
                        F1 = PRES 'MASS' MOD_MEC SUPTAB.'LEVRE_INFERIEURE' -1. ;
                FINSI ;
                DIR2 = REDU F1 (SUPTAB.'FRONT_FISSURE') ;
                DIR2 = EXCO DIR2 MFI MUI 'NOID' ;
                NDIR2 = (PSCA DIR2 DIR2 MUI MUI)**0.5 ;
                DIR2 = DIR2 / NDIR2 ;
                SI (EGA GDIME 3) ;
                        DIR3 = PVEC DIR1 DIR2 MUI MUI MUI ;
                FINSI ;
        FINSI ;
FINSI ;
SI BOOL.'TRAC' ;
        VCHTHETA = VECT CHTHETA 'DEPL' 'BLEU' ;
        TRAC VCHTHETA (MAILLAGE ET M_FRONT) 'TITR' 'CHAMP_THETA' ;
FINSI ;
 
 
* DETERMINATION DU REPERE LOCAL
* *****************************
 
* ON STOCKE LES DIRECTIONS DANS UTILTETA
* DIRECTION DE PROPAGATION : DIR1
* DIRECTION TANGENTE AU FRONT : DIR2
* DIRECTION DE CISAILLEMENT SI SEPARATION DE MODES : DIR3
UTILTETA = TABL ;
UTILTETA.'DIRECTION1' = DIR1 ;
SI (NON BOOL.'COQ') ;
        UTILTETA.'DIRECTION2' = DIR2 ;
        SI (EGA GDIME 3) ;
                UTILTETA.'DIRECTION3' = DIR3 ;
        FINSI ;
FINSI ;
 
 
* ON COMPLETE ELTETA
* ******************
 
* AJOUT EVENTUEL DE ELPI A ELTETA
 SI ((EXIS SUPTAB 'FRONT_FISSURE_2') ET BOOL.'DJ/DA') ;
        ELPI = SUPTAB.'FRONT_FISSURE_2' ;
        REPE MAIL2 ((SUPTAB.'COUCHE') + 1) ;
                ELPI = MAILLAGE ELEM 'APPU' 'LARG' ELPI ;
        FIN MAIL2 ;
        ELTETA = ELTETA ET ELPI ;
 FINSI ;
 
* AJOUT DU NOEUD SUPPORT EN DEF.PL.GENERALISEES
SI (EGA GMODE 'PLANGENE') ;
        ELTETA = ELTETA ET (VALE 'MODE' 'PLANGENE') ;
FINSI ;
ELPOI1 = CHAN ELTETA 'POI1' ;
 
* L'ELEMENT SUPPORTANT LE MODELE MULTICOUCHE
* DOIT ETRE DANS LA ZONE THETA
SI BOOL.'COQ' ;
        N1 = NBNO ELTETA ;
        N2 = NBNO (ELTETA ET (EXTR M_MOYE 'MAIL')) ;
        SI (NEG N1 N2) ;
                MESS 'ERREUR : L ELEMENT EN MULTICOUCHE DESIGNE POUR CALCULER' ;
                MESS '         L INTEGRALE SE TROUVE EN DEHORS DE LA ZONE' ;
                MESS '         DEFINIE PAR LE NOMBRE DE COUCHES DONNE.' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
FINSI ;
 
 
* TESTS DE COMPATIBILITE
* **********************
 
* BOOL.'REPRI' = VRAI SI REPRISE DE CALCUL, FAUX SINON
BOOL.'REPRI' = FAUX ;
SI (BOOL.'PASAPAS' ET (NON BOOL.'PERSO1')) ;
        N1 = DIME (SUPTAB.'SOLUTION_PASAPAS'.'TEMPS') ;
        SI ((EXIS SUPTAB 'IABC') ET
                (EXIS SUPTAB 'ELTET1') ET
                (EXIS SUPTAB 'RESULTATS') ET
                (EXIS SUPTAB 'EVOLUTION_RESULTATS')) ;
                BOOL.'REPRI' = (N1 - 1) > SUPTAB.'IABC' ;
                MESS 'on tente une reprise...' ;
        FINSI ;
FINSI ;
 
* TESTS DE COMPATIBILITE SI REPRISE DE CALCUL
SI BOOL.'REPRI' ;
*       ON VERIFIE QUE L OBJECTIF RESTE LE MEME
        SI (NEG SUPTAB.'OBJ1' SUPTAB.'OBJECTIF') ;
                MESS 'ERREUR : REPRISE IMPOSSIBLE CAR L OBJECTIF DU' ;
                MESS '         CALCUL ACTUEL N EST PAS LE MEME QUE' ;
                MESS '         CELUI DU CALCUL PRECEDENT' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
*       ON DOIT AVOIR LE MEME NOMBRE DE COUCHE (ON SUPPOSE LA FISSURE FIXE)
        SI ((EXIS SUPTAB 'COUCHE') ET (EXIS SUPTAB 'COU1')) ;
                SI (NEG SUPTAB.'COU1' SUPTAB.'COUCHE') ;
                        MESS 'ERREUR : REPRISE IMPOSSIBLE CAR LE NOMBRE DE' ;
                        MESS '         COUCHE ACTUEL N EST PAS LE MEME QUE' ;
                        MESS '         CELUI UTILISE POUR LE CALCUL PRECEDENT' ;
                        ERRE 21 ; QUIT G_THETA ;
                FINSI ;
        FINSI ;
*       RESTE A VERIFIER LA COMPATIBILITE DES SUPPORT DE CHAMP TETA VIA ELTETA
*       ELTETA DOIT ETRE INCLUS DANS ELTET1
        ELTET1 = SUPTAB.'ELTET1' ;
        SI(NEG (NBNO ELTETA) (NBNO (ELTET1 INTE ELTETA))) ;
                MESS 'ERREUR : REPRISE IMPOSSIBLE CAR LE SUPPORT DU ' ;
                MESS '         CHAMP_THETA FOURNI N EST PAS INCLUS DANS' ;
                MESS '         CELUI UTILISE POUR LE CALCUL PRECEDENT' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        MESS 'REPRISE DU CALCUL AUTORISE !' ;
FINSI ;
 
* TESTS DE COMPATIBILITE SI UTILISATION DE PERSO1
SI (BOOL.'PERSO1' ET (EXIS SUPTAB 'ELTET1')) ;
        ELTET1 = SUPTAB.'ELTET1' ;
        SI(NEG (NBNO ELTETA) (NBNO (ELTET1 INTE ELTETA))) ;
                MESS 'ERREUR : REPRISE IMPOSSIBLE CAR LE SUPPORT DU ' ;
                MESS '         CHAMP_THETA FOURNI N EST PAS INCLUS DANS' ;
                MESS '         CELUI UTILISE POUR LE CALCUL PRECEDENT' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
        SI BOOL.'MESS' ;
                MESS 'POURSUITE DU CALCUL VIA PERSO1 AUTORISE !' ;
        FINSI ;
FINSI ;
 
 
* =============================================================================
 
* MODELES ET MATERIAUX DANS LA ZONE DE TRAVAIL
* --------------------------------------------
 
* VERIFICATION DES DONNEES D ENTREE POUR MODELES_COMPOSITES
SI (EXIS SUPTAB 'MODELES_COMPOSITES') ;
        N1 = DIME SUPTAB.'MODELES_COMPOSITES' ;
        M1 = EXTR MOD_MEC 'MAIL' ;
        M2 = VIDE 'MAILLAGE' ;
        REPE BIN4 N1 ;
                T1 = TYPE SUPTAB.'MODELES_COMPOSITES'.&BIN4 ;
                SI (NEG T1 'MMODEL  ') ;
                        MESS 'ERREUR : LE TYPE DE L OBJET No' &BIN4 'DANS LA' ;
                        MESS '         TABLE MODELES_COMPOSITES EST INCORRECTE' ;
                        ERRE 21 ; QUIT G_THETA ;
                FINSI ;
                M2 = M2 ET (EXTR SUPTAB.'MODELES_COMPOSITES'.&BIN4 'MAIL') ;
        FIN BIN4 ;
        SI (NEG (NBNO M1) (NBNO M2)) ;
                MESS 'ERREUR : TOUS LES MODELES DE MATERIAUX' ;
                MESS '         COMPOSITES NE SONT PAS DONNES' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
FINSI ;
 
* CREATION DE MOD_MEC ET TABMOD
TABMOD = TABL ;
SI (EXIS SUPTAB 'MODELES_COMPOSITES') ;
*       CAS DE MODELES COMPOSITES (AVEC DISCONTINUITE) : ON A DU TRAVAIL
        MOD_MEC_R = VIDE 'MMODEL' ;
        REPE BIN1 (DIME SUPTAB.'MODELES_COMPOSITES') ;
                M1 = SUPTAB.'MODELES_COMPOSITES'.&BIN1 ;
                M2 = EXTR M1 'MAIL' ;
                N1 = NBNO M2 ;
                N2 = NBNO ELTETA ;
                N3 = NBNO (ELTETA ET M2) ;
*               SI ON A DES NOEUDS EN COMMUN, ...
                SI (NEG (N1 + N2) N3) ;
                        M2 = CHAN M2 'POI1' ;
*                       ... ON LES RECUPERE
                        E1 = (DIFF ELPOI1 M2) DIFF (ELPOI1 ET M2) ;
                        N1 = NBNO (CONT ELTETA) ;
                        N2 = NBNO (E1 ET (CONT ELTETA)) ;
*                       SI TOUS LES NOEUDS EN COMMUN SONT SUR LE CONTOUR
*                       => PAS D ELEMENTS A RECUPERER => ON PASSE AU MODELE SUIVANT
                        SI (EGA N1 N2) ;
                                ITER BIN1 ;
                        FINSI ;
*                       SINON, ON RECUPERE LES ELEMENTS CONCERNES ET LE MODELE REDUIT
                        E1 = MAILLAGE ELEM 'APPU' 'STRI' E1 ;
                        N1 = (DIME TABMOD) + 1 ;
                        TABMOD.N1 = REDU M1 E1 ;
                        MOD_MEC_R = MOD_MEC_R ET TABMOD.N1 ;
                FINSI ;
        FIN BIN1 ;
SINON ;
*       CAS DE MODELES SANS DISCONTINUITE : ON A MOINS DE TRAVAIL
        MOD_MEC_R = REDU MOD_MEC ELTETA ;
        TABMOD.1 = MOD_MEC_R ;
FINSI ;
NBOBJ = DIME TABMOD ;
MAT_MEC = REDU MAT_MEC MOD_MEC_R ;
 
* CHAMP EPAISSEUR DANS LA ZONE DE TRAVAIL
SI BOOL.'COQ' ;
        EPAICH = (CHAN (EXCO MAT_MEC 'EPAI' 'SCAL')
                                'STRESSES' MOD_MEC_R) CHAN 'TYPE' 'SCALAIRE' ;
FINSI ;
 
 
* CALCUL DE C* PAR DEUX TYPES DE MODELE FLUAGE
* ********************************************
*** ITYPEF = 1  MODELE FLUAGE POUR LEQUEL ON A UNE EXPRESSION
***             EXPLICITE DE L'INTEGRATION DE LA VITESSE DE
***             DEFORMATION DE FLUAGE SUR LE TEMPS
*** ITYPEF = 2  MODELE FLUAGE POUR LEQUEL ON N'OBTIENT PAS
***             FACILEMENT CETTE EXPRESSION EXPLICITE
*** ITYPEF = 99 SI EN ELASTO OU THERMO-ELASTO-PLASTICITE
 
* DETERMINATION DE ITYPEF
ITYPEF = 99 ;
SI (BOOL.'C*' OU BOOL.'C*H') ;
        SI ((EXIS MOD_MEC_R 'MATE' 'FLUAGE' 'NORTON') OU
                (EXIS MOD_MEC_R 'MATE' 'FLUAGE' 'POLYNOMIAL')) ;
                ITYPEF = 1 ;
        FINSI ;
        SI ((EXIS MOD_MEC_R 'MATE' 'FLUAGE' 'BLACKBURN') OU
                (EXIS MOD_MEC_R 'MATE' 'FLUAGE' 'RCCMR_316') OU
                (EXIS MOD_MEC_R 'MATE' 'FLUAGE' 'RCCMR_304') OU
                (EXIS MOD_MEC_R 'MATE' 'FLUAGE' 'LEMAITRE')) ;
                ITYPEF = 2 ;
        FINSI ;
FINSI ;
 
 
* INTERFACES DANS LA ZONE DE TRAVAIL
* **********************************
 
* CREATION DES INTERFACES INTER-MODELE
BOOL.'PARAL' = VRAI ; LINTER = TABL ;
SI ((EXIS SUPTAB 'MODELES_COMPOSITES') ET ((DIME TABMOD) > 1)) ;
*       ON BOUCLE SUR LES MODELES QUI APPARTIENNENT A ELTETA
        REPE BIN2 ((DIME TABMOD) - 1) ;
                M1 = EXTR (TABMOD.&BIN2) 'MAIL' ;
                IIN3 = &BIN2 ;
                NIN3 = (DIME TABMOD) - &BIN2 ;
                REPE BIN3 NIN3 ;
                        IIN3 = IIN3 + 1 ;
                        LE1 = LECT &BIN2 IIN3 ;
                        M2 = EXTR (TABMOD . IIN3) 'MAIL' ;
*                       ON ITERE SI (M1 INCLUT DANS M2) OU (M2 INCLUT DANS M1)
                        SI (EGA (NBNO (M1 DIFF M2)) 0) ;
                                ITER BIN3 ;
                        FINSI ;
*                       ON ITERE SI M1 ET M2 N ONT PAS DE NOEUDS COMMUNS
                        SI (EGA ((NBNO M1) + (NBNO M2)) (NBNO (M1 ET M2))) ;
                                ITER BIN3 ;
                        FINSI ;
*                       ON RECUPERE L INTERFACE M1-M2
                        L1 = (CONT M1) ELEM 'APPU' (CONT M2) ;
                        N1 = NBNO M1 ; N2 = NBNO M2 ;
*                       LO1=VRAI <=> IL EXISTE DES NOEUDS COMMUNS A M1 ET M2
                        LO1 = NEG (N1 + N2) (NBNO (M1 ET M2)) ;
*                       LO2=VRAI <=> IL N'Y A PAS 1 NOEUD COMMUN A M1 ET M2
                        LO2 = NEG ('ABS' ((N1 + N2) - (NBNO (M1 ET M2)))) 1 ;
*                       LO4 = M1 ET M2 FORMENT BIEN UNE INTERFACE ET NE SE CHEVAUCHENT PAS
                        LO4 = NEG (NBEL L1) 0 ;
                        SI (LO1 ET LO2 ET LO4) ;
*                               ON AJOUTE L INTERFACE CAR ON A >1 NOEUDS EN COMMUN A M1 ET M2
                                LINTER.LE1 = L1 ;
*                               BOOL.'PARAL'=VRAI <=> TOUTES LES INTERFACES SONT // A LA FISSURE
*                               SI BOOL.'PARAL'=FAUX IL FAUT AJOUTER DES TERMES D INTERFACES AU C
                                P1 = (POIN L1 1) MOIN (POIN L1 2) ;
                                P1 = P1 / (NORM P1) ;
*                               PETITE MODIF CAR DIR1 DOIT ETRE UN CHPOINT DESORMAIS
*                               -> A VERIFIER ?
                                PDIR1 = RESU DIR1 ;
                                PRESU = (EXTR PDIR1 'MAIL') POIN 1 ;
                                XDIR1 = EXTR PDIR1 PRESU 'UX' ;
                                YDIR1 = EXTR PDIR1 PRESU 'UY' ;
                                SI (GDIME EGA 2) ;
                                        PDIR1 = XDIR1 YDIR1 ;
                                SINON ;
                                        ZDIR1 = EXTR PDIR1 PRESU 'UZ' ;
                                        PDIR1 = XDIR1 YDIR1 ZDIR1 ;
                                FINSI ;
                                PDIR1 = PDIR1 / (NORM PDIR1) ;
                                LO1 = ((EGA P1 PDIR1 1.E-6) OU
                                                (EGA P1 (-1.*PDIR1) 1.E-6)) ;
                                BOOL.'PARAL' = BOOL.'PARAL' ET LO1 ;
                        FINSI ;
                FIN BIN3 ;
        FIN BIN2 ;
FINSI ;
 
* DANS LE CAS DECOUPLAGE SEULEMENT :
* TEST SI FRONT_FISSURE EST DANS UNE INTERFACE
BOOL.'DANS' = FAUX ;
SI ((NEG (DIME LINTER) 0) ET BOOL.'DECOUPLAGE') ;
        IND1 = INDE LINTER ;
        REPE BIN4 (DIME IND1) ;
                LE1 = IND1.&BIN4 ;
                M1 = CHAN LINTER.LE1 'POI1' ;
                N1 = NBNO M1 ;
                N2 = NBNO (M1 ET SUPTAB.'FRONT_FISSURE') ;
                SI (EGA N1 N2) ;
                        BOOL.'DANS' = VRAI ;
                        QUIT BIN4 ;
                SINON ;
                        ITER BIN4 ;
                FINSI ;
        FIN BIN4 ;
FINSI ;
* SI OUI (BOOL.'DANS'),ON DETERMINE LES MODELES SUP ET INF
MODINF = 0 ;  MODSUP = 0 ;
SI BOOL.'DANS' ;
*       ON REDEFINIT : BOOL.'PARAL'=VRAI <=> L'INTERFACE A LAQUELLE APPARTIENT LA FISSURE E
        BOOL.'PARAL' = FAUX ;
        M1 = EXTR TABMOD.(EXTR LE1 1) 'MAIL' ;
        M2 = EXTR TABMOD.(EXTR LE1 2) 'MAIL' ;
        LSUP = SUPTAB.'LEVRE_SUPERIEURE' ;
        LINF = SUPTAB.'LEVRE_INFERIEURE' ;
        N1 = NBNO M1 ;
        N2 = NBNO M2 ;
        NLSUP = NBNO LSUP ;
        NLINF = NBNO LINF ;
        N1SUP = NBNO (M1 ET LSUP) ;
        N2INF = NBNO (M2 ET LINF) ;
        SI ( ((N1 + NLSUP - N1SUP) > 1) ET ((N2 + NLINF - N2INF) > 1)) ;
*               LSUP ET MOD1 ONT PLUS D'1 POINT COMMUN  ET  IDEM POUR LINF ET MOD2
                MODSUP = TABMOD.(EXTR LE1 1) ;
                MODINF = TABMOD.(EXTR LE1 2) ;
        SINON ;
                N1INF = NBNO (M1 ET LINF) ;
                N2SUP = NBNO (M2 ET LSUP) ;
                SI ( ((N1 + NLINF - N1INF) > 1) ET ((N2 + NLSUP - N2SUP) > 1)) ;
                        MODSUP = TABMOD.(EXTR LE1 2) ;
                        MODINF = TABMOD.(EXTR LE1 1) ;
                SINON ;
                        MESS 'ERREUR : INCOMPATIBILITE ENTRE LE MODELES_COMPOSITES' ;
                        MESS '         ET LES LEVRE_SUPERIEURE ET _INFERIEURE' ;
                        ERRE 21 ; QUIT G_THETA ;
                FINSI ;
        FINSI ;
*       LA FISSURE EST BIEN DANS LE PROLONGEMENT DE L' INTERFACE
        BOOL.'PARAL' = VRAI ;
FINSI ;
* REM: il faudrait egalement verifier que MODSUP et MODINF suffisent a decrire E
 
 
* MODPLA : table indicee par entier pour stocker les modeles
*          mecaniques de chaque objet MMODEL.
**************************************************
*** Elle est vide si le modele est elastique ou elastoplastique
*** avec une courbe de traction independante de la temperature.
*** Dans le cas contraire la table vaut :
***    1 si le modele est plastique isotrope. Alors une
***      nouvelle courbe de traction EPSE-SIGMA est faite.
***    2 si le modele est plastique cinematique
***    3 si le modele est plastique parfaite
 
BOOL.'GRADYOUN' = FAUX ; BOOL.'GRADNU' = FAUX ;
BOOL.'GRADALPH' = FAUX ; MODPLA = TABLE ; TABTRA = TABLE ;
 
REPE BCMOD1 NBOBJ ;
        MODEI = TABMOD.&BCMOD1 ;
        MATEI = REDU MAT_MEC MODEI ;
 
*       BOOL.'GRADYOUN'
        YO1 = EXCO MATEI 'YOUN' ;
        TYPYO = TYPE (EXTR YO1 'YOUN' 1 1 1) ;
        SI (EGA TYPYO 'EVOLUTIO') ;
                BOOL.'GRADYOUN' = VRAI ;
        SINON ;
                TEST1 = ((MAXI YO1) - (MINI YO1))/(MINI YO1) ;
                SI (TEST1 '>' 1.E-10) ;
                        BOOL.'GRADYOUN' = VRAI ;
                FINSI ;
        FINSI ;
 
*       BOOL.'GRADNU'
        NU1 = EXCO MATEI 'NU' ;
        TYPNU = TYPE (EXTR NU1 'NU' 1 1 1) ;
        SI (EGA TYPNU 'EVOLUTIO') ;
                BOOL.'GRADNU' = VRAI ;
        SINON ;
                TEST1 = ((MAXI NU1) - (MINI NU1))/(MINI NU1) ;
                SI (TEST1 '>' 1.E-10) ;
                        BOOL.'GRADNU' = VRAI ;
                FINSI ;
        FINSI ;
 
*       BOOL.'GRADALPH'
        SI BOOL.'THER' ;
                AL1 = EXCO MATEI 'ALPH' ;
                TYPAL = TYPE (EXTR AL1 'ALPH' 1 1 1) ;
                SI (EGA TYPAL 'EVOLUTIO') ;
                        BOOL.'GRADALPH' = VRAI ;
                SINON ;
                        TEST1 = ((MAXI AL1) - (MINI AL1))/(MINI AL1) ;
                        SI (TEST1 '>' 1.E-10) ;
                                BOOL.'GRADALPH' = VRAI ;
                        FINSI ;
                FINSI ;
        FINSI ;
 
*       COURBE DE TRACTION
        SI (EXIS MATEI 'ECRO') ;
                TR1 = EXCO MATEI 'ECRO' ;
                TYPTR = TYPE (EXTR TR1 'ECRO' 1 1 1) ;
                SI (EGA TYPTR 'NUAGE   ') ;
                        MODPLA.&BCMOD1 = 1 ;
                        TRA1 = EXTR TR1 'ECRO' 1 1 1 ; COM1 = EXTR TRA1 'COMP' ;
                        NOMEVO1 = MOT 'ECRO' ; NOMFLO1 = MOT 'T' ;
                        REPE BNUA1 (DIME TRA1 'UPLE') ;
                                SI (EGA &BNUA1 1) ;
                                        NUA1 = EXTR TRA1 'MINI' NOMFLO1 ;
                                SINON ;
                                        NUA1 = EXTR TRA1 'SUPE' NOMFLO1 (T1 + 1.E-10) ;
                                FINSI ;
                                T1 =  EXTR NUA1 NOMFLO1 ;
                                EV1 = EXTR NUA1 NOMEVO1 ;
                                PSIG1 = EXTR EV1 ORDO ; PEPS1 = EXTR EV1 'ABSC' ;
                                VYOU1 = (EXTR 2 PSIG1) / (EXTR 2 PEPS1) ;
                                PEPS2 = PROG ;
                                REPE BSIG1 ((DIME PSIG1) - 1) ;
                                        VA1 = (EXTR (&BSIG1 + 1) PEPS1) -
                                        ((EXTR (&BSIG1 + 1) PSIG1) / VYOU1) ;
                                        PEPS2 = PEPS2 ET (PROG VA1) ;
                                FIN BSIG1 ;
                                EV1 = EVOL 'MANU' 'EPSE' PEPS2 SIGM ('ENLE' PSIG1 1) ;
                                SI (&BNUA1 EGA 1) ;
                                        TRA2 = 'NUAG' 'COMP' NOMFLO1 T1 'COMP' NOMEVO1 EV1 ;
                                SINON ;
                                        TRA2 = TRA2 ET ('NUAG' 'COMP' NOMFLO1
                                        T1 'COMP' NOMEVO1 EV1) ;
                                FINSI ;
                        FIN BNUA1 ;
                        TABTRA.&BCMOD1 = TRA2 ;
*                       ON ENLEVE LA COURBE DE TRACTION SI ELLE DEPEND DE
*                       LA TEMPERATURE (OPERATION TROP COUTEUSE POUR VARI)
                        MAT0 = MATEI ; LCOMP1 = EXTR MAT0 'COMP' ;
                        REPE BCOM1 (DIME LCOMP1) ;
                                C1 = EXTR LCOMP1 &BCOM1 ;
                                SI (NEG C1 'ECRO') ;
                                        SI (EGA &BCOM1 1) ;
                                                MATEI = 'MATE' MODEI C1 (EXCO C1 MAT0) ;
                                        SINON ;
                                                MATEI = MATEI ET ('MATE' MODEI C1 (EXCO C1 MAT0)) ;
                                        FINSI ;
                                FINSI ;
                        FIN BCOM1 ;
                FINSI ;
*       SIGY (et pas TRAC)
        SINON ;
                SI (EXIS MATEI 'SIGY') ;
                        SI1 = EXCO MATEI 'SIGY' ;
                        TYPSI = TYPE (EXTR SI1 'SIGY' 1 1 1) ;
                        SI (EXIS MATEI 'H') ;
                                H1 = EXCO MATEI 'H' ;
                                TYPH = TYPE (EXTR H1 'H' 1 1 1) ;
                                SI ((EGA TYPH 'EVOLUTIO') OU
                                        (EGA TYPSI 'EVOLUTIO')) ;
                                        MODPLA.&BCMOD1 = 2 ;
                                FINSI ;
                        SINON ;
                                SI (EGA TYPSI 'EVOLUTIO') ;
                                        MODPLA.&BCMOD1 = 3 ;
                                FINSI ;
                        FINSI ;
                FINSI ;
        FINSI ;
FIN BCMOD1 ;
BOOL.'GRADPROP' = BOOL.'GRADYOUN' OU BOOL.'GRADNU' OU BOOL.'GRADALPH'  OU ((DIME MODPLA) '>' 0) ;
 
 
* CAS IMPOSSIBLE A TRAITER
* ************************
 
SI (EXIS SUPTAB 'MODELES_COMPOSITES') ;
        SI (BOOL.'DECOUPLAGE' ET (BOOL.'DANS' ET (NON BOOL.'PARAL'))) ;
                MESS 'ERREUR : ON NE PEUT ENCORE DECOUPLER LES MODES' ;
                MESS '         DANS LE CAS DES MATERIAUX COMPOSITES' ;
                MESS '         SI LA FISSURE N APPARTIENT PAS A L INTERFACE' ;
                ERRE 21 ; QUIT G_THETA ;
        FINSI ;
FINSI ;
 
 
* =============================================================================
 
* PREREQUIS POUR EFFECTUER LES CALCULS
* ------------------------------------
 
* TITRES A AFFICHER SELON LE PROBLEME TRAITER
* *******************************************
 
SI BOOL.'PASAPAS' ;
        TXMECANI= MOT '  Mecanique' ;
        TXTERMI = MOT '    Thermique' ;
        TXPRESS = MOT '    Volumique' ;
SINON ;
        TXMECANI= MOT ' Mecanique' ;
        TXTERMI = MOT '    Thermique' ;
        TXPRESS = MOT '    Volumique' ;
FINSI ;
MC1 = MOT ' EN VISCO-THERMO-PLASTIQUE' ;
MC2 = MOT ' EN VISCO-PLASTICITE' ;
MC3 = MOT ' EN THERMO-PLASTICITE' ;
MC4 = MOT ' EN ELASTO-PLASTICITE' ;
SI (EXIS SUPTAB 'COUCHE') ;
        MC10 = CHAI ' (Theta ' SUPTAB.'COUCHE' ')' ;
SINON ;
        MC10 = CHAI ' (Theta utilisateur)' ;
FINSI ;
SI BOOL.'J' ;
        CHA1 = CHAI 'INTEGRALE J EN FONCTION DU TEMPS' ;
        MOTTI = MOT 'J' ;
        MOTCO = MOT '         J' ;
        SI BOOL.'THER' ;
                TX1 = CHAI '        INTEGRALE J' MC3 ;
        SINON ;
                TX1 = CHAI '        INTEGRALE J' MC4 ;
        FINSI ;
FINSI ;
SI BOOL.'C*' ;
        CHA1 = CHAI 'INTEGRALE C* EN FONCTION DU TEMPS' ;
        MOTTI = MOT 'C*' ;
        MOTCO = MOT '        C*' ;
        SI BOOL.'THER' ;
                TX1 = CHAI '       INTEGRALE C*' MC1 ;
        SINON ;
                TX1 = CHAI '        INTEGRALE C*' MC2 ;
        FINSI ;
FINSI ;
SI BOOL.'C*H' ;
        CHA1 = CHAI 'INTEGRALE C*H EN FONCTION DU TEMPS' ;
        MOTTI = MOT 'C*H' ;
        MOTCO = MOT '       C*(H)' ;
        SI BOOL.'THER' ;
                TX1 = CHAI '          INTEGRALE C*H' MC1 ;
        SINON ;
                TX1 = CHAI '       INTEGRALE C*H' MC2 ;
        FINSI ;
FINSI ;
SI BOOL.'DJ/DA' ;
        SI (EXIS SUPTAB 'FISSURE_2') ;
                CHA1 = CHAI 'INTEGRALE CROISEE DJi/DAj EN FONCTION DU TEMPS' ;
                MOTTI = MOT 'DJi/DAj' ;
                MOTCO = MOT '      dJi/dAj' ;
                SI BOOL.'THER' ;
                        TX1 = CHAI '      INTEGRALE CROISEE DJi/DAj' MC3 ;
                SINON ;
                        TX1 = CHAI '  INTEGRALE CROISEE DJi/DAj' MC4 ;
                FINSI ;
        SINON ;
                CHA1 = CHAI 'INTEGRALE DJ/DA EN FONCTION DU TEMPS' ;
                MOTTI = MOT 'DJ/DA' ;
                MOTCO = MOT '       dJ/dA' ;
                SI BOOL.'THER' ;
                        TX1 = CHAI '      INTEGRALE DJ/DA' MC3 ;
                SINON ;
                        TX1 = CHAI '      INTEGRALE DJ/DA' MC4 ;
                FINSI ;
        FINSI ;
FINSI ;
SI BOOL.'J_DYNA' ;
        CHA1 = CHAI 'INTEGRALE J DYNAMIQUE EN FONCTION DU TEMPS' ;
        MOTTI = MOT 'J_DYNA' ;
        MOTCO = MOT '      J_DYNA' ;
        SI BOOL.'THER' ;
                TX1 = CHAI '     INTEGRALE J EN THERMO-ELASTO-DYNAMIQUE' ;
        SINON ;
                TX1 = CHAI '         INTEGRALE J EN ELASTO-DYNAMIQUE' ;
        FINSI ;
FINSI ;
SI BOOL.'DECOUPLAGE' ;
        CHA1=CHAI 'F.I.C. Ki EN FONCTION DU TEMPS' ;
        MOTTI = MOT 'Ki' ;
        MOTCO = MOT '         K' ;
        SI BOOL.'THER' ;
                TX1 = CHAI ' SEPARATION DES F.I.C.' MC3 ;
        SINON ;
                TX1 = CHAI ' SEPARATION DES F.I.C.' MC4 ;
        FINSI ;
FINSI ;
TX2 = CHAI ' Contribution due au chargement' MC10 ;
TX3 = CHAI ' ________________________________________' ;
SI (EXIS SUPTAB 'COUCHE') ;
        SI (SUPTAB.'COUCHE' > 9) ;
                TX3 = CHAI ' _________________________________________' ;
        FINSI ;
        SI (SUPTAB.'COUCHE' > 99) ;
                TX3 = CHAI ' __________________________________________' ;
        FINSI ;
SINON ;
        TX3 = CHAI ' _____________________________________________' ;
FINSI ;
 
* AFFICHAGE DU TITRE
* ******************
 
SI BOOL.'PASAPAS' ;
        SI (EGA GDIME 2) ;
                SI BOOL.'DECOUPLAGE' ;
                        MESS '          ' TX1 ;
                        MESS '           ' TX2 ; MESS '           ' TX3 ;
                        MESS 'Mode  No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO ;
                SINON ;
                        MESS '       ' TX1 ;
                        MESS '          ' TX2 ; MESS '          ' TX3 ;
                        MESS ' No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO ;
                FINSI ;
        FINSI ;
        SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
                SI BOOL.'DECOUPLAGE' ;
                        MESS '              ' TX1 ;
                        MESS '               ' TX2 ; MESS '               ' TX3 ;
                        MESS 'Mode  Noeud  No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO ;
                SINON ;
                        MESS '           ' TX1 ;
                        MESS '              ' TX2 ; MESS '              ' TX3 ;
                        MESS '  Noeud  No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO ;
                FINSI ;
        FINSI ;
        SI BOOL.'COQ' ;
                MESS '           ' TX1 ;
                MESS ;
                MESS '              ' TX2 ; MESS '              ' TX3 ;
                MESS '  Plan   No.Pas ' TXMECANI TXTERMI TXPRESS MOTCO ;
        FINSI ;
SINON ;
        SI (EGA GDIME 2) ;
                SI BOOL.'DECOUPLAGE' ;
                        MESS '        ' TX2 ; MESS '        ' TX3 ;
                        MESS 'Mode  ' TXMECANI TXTERMI TXPRESS MOTCO ;
                SINON ;
                        MESS '    ' TX2 ; MESS '    ' TX3 ;
                        MESS ' ' TXMECANI TXTERMI TXPRESS MOTCO ;
                FINSI ;
        FINSI ;
        SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
                SI BOOL.'DECOUPLAGE' ;
                        MESS '            ' TX2 ; MESS '            ' TX3 ;
                        MESS ' Mode   Noeud  ' TXMECANI TXTERMI TXPRESS MOTCO ;
                SINON ;
                        MESS '          ' TX2 ; MESS '          ' TX3 ;
                        MESS '  Noeud  ' TXMECANI TXTERMI TXPRESS MOTCO ;
                FINSI ;
        FINSI ;
        SI BOOL.'COQ' ;
                MESS '          ' TX2 ; MESS '          ' TX3 ;
                MESS '  Plan   ' TXMECANI TXTERMI TXPRESS MOTCO ;
        FINSI ;
FINSI ;
 
* FORCE, DEPLACEMENT ET GRADIENT NULS
* ***********************************
 
FOR000 = CHAN 'CHPO' MOD_MEC_R (ZERO MOD_MEC_R 'FORCES  ') ;
DEP000 = CHAN 'CHPO' MOD_MEC_R (ZERO MOD_MEC_R 'DEPLACEM') ;
SI (EGA GMODE 'PLANGENE') ;
        FOR000 = MANU 'CHPO' (EXTR MOD_MEC_R 'MAIL') 2 'FX' 0.
                                'FY' 0. 'TITR' 'FORCES  ' 'NATURE' 'DIFFUS' ;
        FOR000 = FOR000 ET (MANU 'CHPO' (VALE 'MODE' 'PLANGENE')
                                3 'FZ' 0. 'MX' 0. 'MY' 0.
                                'TITR' 'FORCES  ' 'NATURE' 'DIFFUS') ;
        DEP000 = MANU 'CHPO' (EXTR MOD_MEC_R 'MAIL') 2 'UX' 0.
                                'UY' 0. 'TITR' 'DEPLACEM' 'NATURE' 'DIFFUS' ;
        DEP000 = DEP000 ET (MANU 'CHPO' (VALE 'MODE' 'PLANGENE')
                                3 'UZ' 0. 'RX' 0. 'RY' 0.
                                'TITR' 'DEPLACEM' 'NATURE' 'DIFFUS') ;
FINSI ;
CMD001 = CHAN 'STRESSES' MOD_MEC_R (ZERO MOD_MEC_R 'DEPLACEM') ;
GRA000 = ZERO MOD_MEC_R 'GRADIENT' ;
VAR000 = ZERO MOD_MEC_R 'VARINTER' ;
 
 
* NOMBRE DE BOUCLE POUR LE CALCUL DES INTEGRALES
* **********************************************
 
SI BOOL.'PASAPAS' ;
        NBG = -1 ;
        NBDEP = DIME (SUPTAB.'SOLUTION_PASAPAS'.'TEMPS') ;
        SI BOOL.'REPRI' ;
                NBG = SUPTAB.'IABC' ;
                NBDEP = NBDEP - 1 - NBG ;
        FINSI ;
        SI BOOL.'PERSO1' ;
                NBG = (WTAB . 'PAS') - 1 ;
                NBDEP = 1 ;
        FINSI ;
SINON ;
        NBG = -1 ;
        NBDEP = 1 ;
FINSI ;
 
 
* SOLUTION DU PAS PRECEDENT SI REPRISE DE CALCUL OU SI PERSO1
* ***********************************************************
 
SI (BOOL.'REPRI' OU (BOOL.'PERSO1' ET (NBG >EG 0))) ;
        SIG1 = (SUPTAB.'SOLUTION_PASAPAS'.'CONTRAINTES'.NBG) REDU MOD_MEC_R ;
        SI (EXIS (SUPTAB.'SOLUTION_PASAPAS') 'VARIABLES_INTERNES') ;
                VAR1 = (SUPTAB.'SOLUTION_PASAPAS'.'VARIABLES_INTERNES'.NBG)
                                REDU MOD_MEC_R ;
        SINON ;
                VAR1 = VAR000 ;
        FINSI ;
        MAT_INST = SUPTAB.'MAT_INST' ;
        WELAS = 0.5*('ENER' MOD_MEC_R SIG1 ('ELAS' MOD_MEC_R SIG1 MAT_INST)) ;
        WPLAS = (REDU MOD_MEC_R SUPTAB.'END1') - WELAS ;
        SI (EGA ITYPEF 2) ;
                VDI1 = SUPTAB.'VDI1' ;
        FINSI ;
        SI (((DIME MODPLA) > 0) ET BOOL.'THER') ;
                WVMIS = SUPTAB.'ENV1' ;
        FINSI ;
        SI BOOL.'MESS' ;
                MESS 'RECUP DU PAS PRECEDENT OK' ;
        FINSI ;
FINSI ;
 
* CALCUL DE LA DEFORMATION THERMIQUE A TREF
SI (BOOL.'THER' ET (NON BOOL.'COQ')) ;
        SI (EXIS MAT_MEC 'TREF') ;
                TREF = REDU (EXCO 'TREF' MAT_MEC 'T') ELTETA ;
                TREF = CHAN 'TYPE' TREF 'TEMPERATURES' ;
        SINON ;
                TREF = MANU 'CHML' MOD_MEC_R 'T' 0. 'TYPE' 'TEMPERATURES' ;
        FINSI ;
        MATREF = VARI 'NUAG' MOD_MEC_R MAT_MEC TREF ;
        EPTREF = EPTH MOD_MEC_R MATREF TREF ;
        EPTREF VAR2 VAR3 = INVA MOD_MEC_R EPTREF ;
        EPTREF = CHAN 'CHAM' (EPTREF/3.) MOD_MEC_R 'NOEUD' ;
        OBJUTI.'EPTREF' = EPTREF ;
FINSI ;
 
 
* REMPLISSAGE DE OBJUTI
* *********************
 
OBJUTI.'MOD_MEC_R' = MOD_MEC_R ;
OBJUTI.'MOTTI' = MOTTI ;
OBJUTI.'MODCOU' = MODCOU ;
OBJUTI.'TABMOD' = TABMOD ;
OBJUTI.'LINTER' = LINTER ;
OBJUTI.'ELTETA' = ELTETA ;
OBJUTI.'MODPLA' = MODPLA ;
OBJUTI.'FOR000' = FOR000 ;
OBJUTI.'DEP000' = DEP000 ;
OBJUTI.'CMD001' = CMD001 ;
OBJUTI.'GRA000' = GRA000 ;
OBJUTI.'ITYPEF' = ITYPEF ;
OBJUTI.'DIRECTION1' = DIR1 ;
OBJUTI.'DIRECTION2' = DIR2 ;
OBJUTI.'DIRECTION3' = DIR3 ;
OBJUTI.'ELTETA' = ELTETA ;
* DECOUPLAGE
OBJUTI.'MODSUP' = MODSUP ;
OBJUTI.'MODINF' = MODINF ;
* AJOUT BP BT POUR LE CONTACT FROTTANT
SI BOOL.'FROT' ;
        OBJUTI.'OBJCON' = OBJCON ;
        OBJUTI.'MAILCON' = MAILCON ;
FINSI ;
* FIN AJOUT BP BT
SI BOOL.'PERSO1' ;
        OBJUTI.'ESTIMATION' = ESTIM ;
FINSI ;
 
***************************************************
** DECLARATION DES TABLES STOCKANT LES RESULTATS **
***************************************************
SI BOOL.'PERSO1' ;
        FLCREA = NBG EGA -1 ;
SINON ; 
        FLCREA = NON BOOL.'REPRI' ;
FINSI ;
SI FLCREA ;
        SI BOOL.'MESS' ;
                MESS 'ON VA CREER SUPTAB.RESULTATS' ;
        FINSI ;
        SI ((EGA GDIME 3) OU BOOL.'PASAPAS' OU BOOL.'DECOUPLAGE') ;
                SUPTAB.'RESULTATS' = TABL ;
        FINSI ;
        SI BOOL.'PASAPAS' ;
                SI ((EGA GDIME 3) OU BOOL.'DECOUPLAGE') ;
                        SUPTAB.'EVOLUTION_RESULTATS' = TABL ;
                FINSI ;
                SI (EGA ITYPEF 99) ;
                        SUPTAB.'CRIT_DECHA_GLOBAL1' = TABLE ;
                        SUPTAB.'CRIT_DECHA_LOCAL1' = TABLE ;
                        SUPTAB.'CRIT_DECHA_GLOBAL2' = TABLE ;
                        SUPTAB.'CRIT_DECHA_GLOBAL2_L' = TABLE ;
                        SUPTAB.'CRIT_DECHA_LOCAL2' = TABLE ;
                FINSI ;
        FINSI ;
        SI (BOOL.'COQ' ET (BOOL.'PASAPAS' OU BOOL.'DECOUPLAGE')) ;
                SUPTAB.'EPAISSEUR_RESULTATS' = TABL ;
        FINSI ;
        SI BOOL.'DECOUPLAGE' ;
                REPE IRUPT GDIME ;
                        MODE_RUPT = (EXTR 'III' 1 &IRUPT) ;
                        SI ((EGA GDIME 3) OU BOOL.'PASAPAS') ;
                                SUPTAB.'RESULTATS'.MODE_RUPT = TABL ;
                        FINSI ;
                        SI ((EGA GDIME 3) ET BOOL.'PASAPAS') ;
                                SUPTAB.'EVOLUTION_RESULTATS'.MODE_RUPT = TABL ;
                        FINSI ;
                        SI (BOOL.'COQ' ET BOOL.'PASAPAS') ;
                                SUPTAB.'EPAISSEUR_RESULTATS'.MODE_RUPT = TABL ;
                        FINSI ;
                FIN IRUPT ;
        FINSI ;
FINSI ;
 
 
***********************************************
***********************************************
********* BOUCLE SUR LE PAS DE CALCUL *********
***********************************************
***********************************************
 
REPE BOUCEXT NBDEP ;
        IABC = NBG + &BOUCEXT ;
 
*       DECLARATION DES TABLES STOCKANT LES RESULTATS POUR LE PAS DE TEMPS IABC
        SI (BOOL.'PASAPAS' ET (EGA GDIME 3)) ;
                SI  BOOL.'DECOUPLAGE' ;
                        REPE IRUPT GDIME ;
                                SUPTAB.'RESULTATS'.(EXTR 'III' 1 &IRUPT).IABC = TABL ;
                        FIN IRUPT ;
                SINON ;
                        SUPTAB.'RESULTATS'.IABC = TABL ;
                FINSI ;
        FINSI ;
 
 
***************************************************
** DEPLACEMENTS,CONTRAINTES ... A L INSTANT INST **
***************************************************
 
        SI BOOL.'PASAPAS' ;
*               SOLUTION_PASAPAS
                SI BOOL.'PERSO1' ;
*                       CAS PERSO1
                        INST   =  ESTIM . 'TEMPS' ;
                        DEPINT = (ESTIM . 'DEPLACEMENTS') REDU ELTETA ;
                        SIGF   = (ESTIM . 'CONTRAINTES' ) REDU MOD_MEC_R ;
                        SI (BOOL.'GRANDS_DEP' ET (NON BOOL.'ROT_RIG')) ;
                                SIGF = 'CAPI' SIGF DEPINT MOD_MEC_R ;
                        FINSI ;
                        SI BOOL.'ROT_RIG' ;
                                SI (NON (EXIS (SUPTAB.'ROTATION_RIGIDIFIANTE') IABC)) ;
                                        MESS 'ERREUR : Le deplacement du a une rotation' ;
                                        MESS '         rigidifiante au pas ' IABC ' n est pas'
                                        MESS '         donne' ;
                                        ERRE 21 ; QUIT G_THETA ;
                                FINSI ;
                                DEPINT = DEPINT -
                                (REDU SUPTAB.'ROTATION_RIGIDIFIANTE'.IABC ELTETA) ;
                        FINSI ;
                        SI (EXIS ESTIM 'VARIABLES_INTERNES') ;
                                VARF = (ESTIM . 'VARIABLES_INTERNES') REDU MOD_MEC_R ;
                        SINON ;
                                VARF = VAR000 ;
                        FINSI ;
                        SI BOOL.'C*' ;
                                SI (EGA IABC 0) ;
                                        DELTAT = INST + 1.E+30 ;
                                        DEPINT = ESTIM . 'DEPLACEMENTS' ;
                                        VITDFI = ESTIM . 'DEFORMATIONS_INELASTIQUES' ;
                                        SIG1 = SIGF * 1. ;
                                FINSI ;
                                SI (IABC '>' 0) ;
                                        DELTAT= INST - (ESTIM . 'TEMPS') ;
                                        DEPINT= (ESTIM.'DEPLACEMENTS') - (ESTIM.'DEPLACEMENTS') ;
                                        VITDFI= (ESTIM.'DEFORMATIONS_INELASTIQUES')
                                                                - (ESTIM.'DEFORMATIONS_INELASTIQUES') ;
                                FINSI ;
                                DEPINT = (REDU ELTETA DEPINT) / DELTAT ;
                                VITDFI = (REDU ELTETA VITDFI) / DELTAT ;
                        FINSI ;
                        SI BOOL.'J_DYNA' ;
                                VITF = (ESTIM .'VITESSES')      REDU ELTETA ;
                                ACCF = (ESTIM .'ACCELERATIONS') REDU ELTETA ;
                        FINSI ;
                SINON ;
*                       CAS OU ON APPELLE G_THETA APRES PASAPAS
                        INST = SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.IABC ;
                        DEPINT = (SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.IABC)
                        REDU ELTETA ;
                        SIGF = (SUPTAB.'SOLUTION_PASAPAS'.'CONTRAINTES'.IABC)
                                        REDU MOD_MEC_R ;
                        SI (BOOL.'GRANDS_DEP' ET (NON BOOL.'ROT_RIG')) ;
                                SIGF = 'CAPI' SIGF DEPINT MOD_MEC_R ;
                        FINSI ;
                        SI BOOL.'ROT_RIG' ;
                                SI (NON (EXIS (SUPTAB.'ROTATION_RIGIDIFIANTE') IABC)) ;
                                        MESS 'ERREUR : Le deplacement du a une rotation' ;
                                        MESS '         rigidifiante au pas ' IABC ' n est pas'
                                        MESS '         donne' ;
                                        ERRE 21 ; QUIT G_THETA ;
                                FINSI ;
                                DEPINT = DEPINT -
                                (REDU SUPTAB.'ROTATION_RIGIDIFIANTE'.IABC ELTETA) ;
                        FINSI ;
                        SI (EXIS (SUPTAB.'SOLUTION_PASAPAS') 'VARIABLES_INTERNES') ;
                                VARF = (SUPTAB.'SOLUTION_PASAPAS'.'VARIABLES_INTERNES'.IABC)
                                REDU MOD_MEC_R ;
                        SINON ;
                                VARF = VAR000 ;
                        FINSI ;
                        SI BOOL.'C*' ;
                                SI (EGA IABC 0) ;
                                        DELTAT = INST + 1.E+30 ;
                                        DEPINT = SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.IABC ;
                                        VITDFI = SUPTAB.'SOLUTION_PASAPAS'.
                                        'DEFORMATIONS_INELASTIQUES'.IABC ;
                                        SIG1 = SIGF * 1. ;
                                FINSI ;
                                SI (IABC > 0) ;
                                        DELTAT = INST - (SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.
                                                                (IABC - 1)) ;
                                        DEPINT = (SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.IABC) -
                                        (SUPTAB.'SOLUTION_PASAPAS'.'DEPLACEMENTS'.(IABC - 1)) ;
                                        VITDFI = (SUPTAB.'SOLUTION_PASAPAS'.
                                                                'DEFORMATIONS_INELASTIQUES'.IABC) -
                                                                (SUPTAB.'SOLUTION_PASAPAS'.
                                                                'DEFORMATIONS_INELASTIQUES'.(IABC - 1)) ;
                                FINSI ;
                                DEPINT = (REDU ELTETA DEPINT) / DELTAT ;
                                VITDFI = (REDU ELTETA VITDFI) / DELTAT ;
                        FINSI ;
                        SI BOOL.'J_DYNA' ;
                                VITF = (SUPTAB.'SOLUTION_PASAPAS'.'VITESSES'.IABC)
                                REDU ELTETA ;
                                ACCF = (SUPTAB.'SOLUTION_PASAPAS'.'ACCELERATIONS'.IABC)
                                REDU ELTETA ;
                        FINSI ;
                FINSI ;
        SINON ;
*               SOLUTION_RESO
                DEPINT = REDU (SUPTAB.'SOLUTION_RESO') ELTETA ;
                SIGF = SIGM 'LINE' DEPINT MOD_MEC_R MAT_MEC ;
        FINSI ;
 
*       ON CHANGE LE DEPLACEMENT DEPINT EN MCHAML AU NOEUD
        DEPINT = CHAN 'CHAM' DEPINT MOD_MEC_R 'NOEUD' 'DEPLACEMENTS' ;
 
 
****************************************************
* MODIFICATION DES CHAMPS THETA ET PI SI GRANDE ROT
****************************************************
 
        SI (BOOL.'PASAPAS' ET BOOL.'ROT_RIG') ;
                FORM SUPTAB.'ROTATION_RIGIDIFIANTE'.IABC ;
                SUPTAB.'CHAMP_THETA' UTILTETA = CH_THETA SUPTAB ;
                SI BOOL.'DJ/DA' ;
                        SI (NON (EXIS SUPTAB 'FRONT_FISSURE_2')) ;
                                SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') - 1 ;
                                SUPTAB.'PI' UTILPI = CH_THETA SUPTAB ;
                                SUPTAB.'COUCHE' = (SUPTAB.'COUCHE') + 1 ;
                        SINON ;
                                P1 = SUPTAB.'FRONT_FISSURE' ;
                                SUPTAB.'FRONT_FISSURE' = SUPTAB.'FRONT_FISSURE_2' ;
                                SUPTAB.'FISSURE' = SUPTAB.'FISSURE_2' ;
                                SUPTAB.'PI' UTILPI = CH_THETA SUPTAB ;
                                SUPTAB.'FRONT_FISSURE' = P1 ;
                        FINSI ;
                FINSI ;
        FINSI ;
 
 
***************************************************
********** TEMPERATURES A L INSTANT INST **********
***************************************************
 
        SI BOOL.'THER' ;
                SI BOOL.'PASAPAS' ;
                        SI BOOL.'THER_DECO' ;
                                TEPINT = 'TIRE' CHAR1 INST 'T' ;
                        SINON ;
*                               bp, 2014-11-13 : ajout distinction cas BOOL.'THER' et BOOL.'THER_DECO'
                                TEPINT = REDU ELTETA SUPTAB.'SOLUTION_PASAPAS'.'TEMPERATURES'.
                                                        IABC ;
                        FINSI ;
                SINON ;
                        TEPINT = SUPTAB.'TEMPERATURES' ;
                FINSI ;
        FINSI ;
 
 
***************************************************                     
********** DEF IMPOSEE A L INSTANT INST **********                     
***************************************************
 
        SI BOOL.'DEF_IMP' ;                                                          
                SI BOOL.'PASAPAS' ; 
                        DEFI = 'TIRE' CHAR1 INST 'DEFI' ;      
                SINON ;
                        DEFI = SUPTAB.'DEFORMATIONS_IMPOSEES' ;      
                FINSI ;
        FINSI ;
 
 
***************************************************                     
********** CONTACT FROTTANT **********                     
***************************************************                     
 
        SI BOOL.'FROT' ;
                SI BOOL.'PASAPAS' ; 
*                       ...TODO
                SINON ;
*                       A PRIORI DEPLACEMENT_FISSURE PAS TRES UTILE ...
                        SI (EXIS SUPTAB 'DEPLACEMENT_FISSURE') ;
                                WDEP  = SUPTAB . 'DEPLACEMENT_FISSURE' ;
                        SINON ;
                                WDEP  = REDU (SUPTAB.'SOLUTION_RESO') MAICON ;    
                        FINSI ;
                        TOTO = EXTR WDEP 'MAIL' ;
                        SI (EGA (NBEL TOTO) 0) ;
                                MESS 'ERREUR : IL FAUT DEPLACEMENT_FISSURE SI MODELE_FISSURE' ;
                                ERRE 21 ; QUIT G_THETA ;
                        FINSI ;
                        SI (EXIS SUPTAB 'PRESSION_FISSURE') ;
                                SIGCON = SUPTAB . 'PRESSION_FISSURE' ;
                        SINON ;
                                SIGCON = REDU SIGF OBJCON ;
                        FINSI ;
*                       PEUT ETRE FAIRE UN TEST SUR SIGCON ...
                FINSI ;
        FINSI ;
 
 
*****************************************************
* CONTRAINTE RECALCULEE SI BOOL.'THER' = VRAI et NON BOOL.'PASAPAS' *
*****************************************************
 
        SI (BOOL.'THER' ET (NON BOOL.'PASAPAS')) ;
                SIGF = SIGF - (THET MOD_MEC_R MAT_MEC TEPINT) ;
        FINSI ;
 
 
***************************************************
************ MATERIAU A L INSTANT INST ************
***************************************************
 
        SI (BOOL.'GRADPROP' ET BOOL.'THER' ET BOOL.'PASAPAS') ;
                MAT_INST = VARI 'NUAG' MOD_MEC_R MAT_MEC (EXCO 'T' TEPINT 'T') ;
        SINON ;
                MAT_INST = MAT_MEC ;
*               bp: ne devrait on pas ecrire ci dessous..? inutile?
*               MAT_INST = REDU MOD_MEC_R MAT_MEC
        FINSI ;
        OBJUTI.'MAT_INST' = MAT_INST ;
 
 
***************************************************
********* RIGIDITE TOTALE A L INSTANT INST ********
***************************************************
 
*       bp: utilite?
        SI ( BOOL.'DJ/DA' OU (BOOL.'DECOUPLAGE'
        ET (NON BOOL.'XFEM') ET (EGA GDIME 3) ET (NON BOOL.'DANS')) ) ;
                SI BOOL.'PASAPAS' ;
                        SI (BOOL.'GRADPROP' ET BOOL.'THER') ;
                                M1 = VARI 'NUAG' MOD_MEC_R (EXCO 'T' TEPINT 'T')
                                (SUPTAB.'SOLUTION_PASAPAS'.'CARACTERISTIQUES') ;
                        SINON ;
                                M1 = SUPTAB.'SOLUTION_PASAPAS'.'CARACTERISTIQUES' ;
                        FINSI ;
                        RIGTOT = RIGI M1 (SUPTAB.'SOLUTION_PASAPAS'.'MODELE') ;
                SINON ;
                        RIGTOT = RIGI (SUPTAB.'CARACTERISTIQUES') (SUPTAB.'MODELE') ;
                FINSI ;
        FINSI ;
        OBJUTI.'RIGTOT' = RIGTOT ;
 
 
********************************************************************
****** CHARGEMENT MECANIQUE (FORCES NODALES) A L INSTANT INST ******
********************************************************************
 
        PREINT = FOR000 ;
        SI BOOL.'PASAPAS' ;
*** SOLUTION_PASAPAS ******************************
                SI (EXIS CHAR1 'MECA') ;
                        PREINT = PREINT + ((TIRE CHAR1 INST 'MECA') REDU ELTETA) ;
                FINSI ;
                SI BOOL.'MODE_PRES' ;
*                       Dans le cas ou il y a un modele de pression
                        MATPRE = TIRE CHAR1 'PRES' INST ;
*                       --> on isole la partie du MMODEL de pression qui est appliquee
*                       sur la fissure
                        SI BOOL.'PRES_FISS' ;
                                MODPF = REDU MODPRE MAILPF ;
                                MATPF = REDU MATPRE MODPF ;
                        FINSI ;
*                       --> on calcule les forces nodales equivalentes aux pressions
*                       appliquees hors de la fissure
                        MAILPEXT = DIFF MAILPTOT MAILPF ;
                        SI ((NBEL MAILPEXT) > 0) ;
                                MODPEXT = REDU MODPRE MAILPEXT ;
                                MATPEXT = REDU MATPRE MODPEXT ;
                                PREINT = PREINT + (BSIG MODPEXT MATPEXT) ;
                        FINSI ;
                FINSI ;
        SINON ;
*** SOLUTION_RESO **********************************
                SI (EXIS SUPTAB 'CHARGEMENTS_MECANIQUES') ;
                        PREINT = PREINT + (SUPTAB.'CHARGEMENTS_MECANIQUES' REDU ELTETA) ;
                FINSI ;
                SI BOOL.'MODE_PRES' ;
*                       Dans le cas ou il y a un modele de pression
*                       --> on isole la partie du MMODEL de pression qui est appliquee sur
*                       la fissure
                        SI BOOL.'PRES_FISS' ;
                                MODPF = REDU MODPRE MAILPF ;
                                MATPF = REDU MATPRE MODPF ;
                        FINSI ;
*                       --> on calcule les forces nodales equivalentes aux pressions
*                       appliquees hors de la fissure
                        MAILPEXT = DIFF MAILPTOT MAILPF ;
                        SI ((NBEL MAILPEXT) > 0) ;
                                MODPEXT = REDU MODPRE MAILPEXT ;
                                MATPEXT = REDU MATPRE MODPEXT ;
                                PREINT = PREINT + (BSIG MODPEXT MATPEXT) ;
                        FINSI ;
                FINSI ;
        FINSI ;
 
 
**********************************************************************
******** POUR LES PRESSIONS APPLIQUEES SUR LA FISSURE
*        on calcule le MCHAML vectoriel de [pression * normale]
**********************************************************************
 
        SI BOOL.'PRES_FISS' ;
*               champ de normale unitaire au maillage de la fissure
                MAT_INSTF = PRES MODPF 'PRES' 1. ;
                NF1   = BSIG MODPF MAT_INSTF ;
                LCOMP = EXTR NF1 'COMP' ;
                NF2   =  CHAN 'CHAM' NF1 MODPF 'STRESSES' ;
                XX    = PSCA NF2 NF2 LCOMP LCOMP ;
                NF    = NF2 / (XX**0.5) ;
*               champ de pression normale au maillage de la fissure
                PF    = CHAN 'STRESSES' MODPF MATPF ;
                PF    = CHAN 'TYPE' PF 'FORCES' ;
                NCOMP = DIME LCOMP ;
                LCP   = MOTS NCOMP*'PRES' ;
                PNF   = PF * NF LCP LCOMP LCOMP ;
        FINSI ;
 
 
****************************************************
***** APPEL A G_AUX POUR LES CHAMPS AUXILIAIRES ****
****************************************************    
 
*       TEST DE G_AUX
        SI BOOL.'DECOUPLAGE' ;
                CH_AUX = G_AUX SUPTAB OBJUTI BOOL ;
                SI (EGA (TYPE CH_AUX) (MOT 'ANNULE')) ;
                        MESS 'ERREUR : G_AUX A RENCONTRE UN PROBLEME' ;
                        QUIT G_THETA ;
                FINSI ;
        FINSI ;
 
*       BOUCLE SUR LES INTEGRALES A CALCULER ==============================*
*       NBMIXT = nbre d integrale a calculer (=1 si J, =2 si K1 K2, =3
*       si K1 K2 K3)
        NBMIXT = 1 ;
        IM = 0 ;
        SI BOOL.'DECOUPLAGE' ;
                NBMIXT = 2 ;
                SI (EGA GDIME 3) ;
                        NBMIXT = 3 ;
                FINSI ;
        FINSI ;
        REPE BOUCMIX NBMIXT ;
                IM = IM + 1 ;
 
****************************************************
**************** EN CAS DE DECOUPLAGE **************
****************************************************
 
                SI BOOL.'DECOUPLAGE' ;
                        MOTMIX = CH_AUX.IM.'MOTMIX' ;
                        MOTMIA = CH_AUX.IM.'MOTMIA' ;
                        A_PREI = CH_AUX.IM.'A_PREI' ;
                        A_DEPI = CH_AUX.IM.'A_DEPI' ;
                        A_SIGF = CH_AUX.IM.'A_SIGF' ;
                        A_DEPGR = CH_AUX.IM.'A_DEPGR' ;
                        C_MATE = OBJUTI.'C_MATE' ;
                FINSI ;
 
 
****************************************************
******* EN CAS DE CALCUL EN VISCO_PLASTICITE *******
****************************************************
 
*               INITIALISATION DE FACT1
                FACT1 = 1. ;
                SI (BOOL.'C*' OU BOOL.'C*H') ;
                        SI (EGA ITYPEF 1) ;
                                CHAF1 = (CHAN 'STRESSES' MOD_MEC_R (EXCO 'AF1 ' MAT_INST 'SCAL'))
                                CHAN 'TYPE' 'SCALAIRE' ;
                                CHAF2 = (CHAN 'STRESSES' MOD_MEC_R (EXCO 'AF2 ' MAT_INST 'SCAL'))
                                CHAN 'TYPE' 'SCALAIRE' ;
                                CHAF3 = (CHAN 'STRESSES' MOD_MEC_R (EXCO 'AF3 ' MAT_INST 'SCAL'))
                                CHAN 'TYPE' 'SCALAIRE' ;
                                SI (EXIS MAT_INST 'AF0 ') ;
                                        CHAF4 =( CHAN 'STRESSES' MOD_MEC_R (EXCO 'AF4 ' MAT_INST 'SCAL'))
                                        CHAN 'TYPE' 'SCALAIRE' ;
                                        CHAF5 =( CHAN 'STRESSES' MOD_MEC_R (EXCO 'AF5 ' MAT_INST 'SCAL'))
                                        CHAN 'TYPE' 'SCALAIRE' ;
                                        CHAF6 = (CHAN 'STRESSES' MOD_MEC_R (EXCO 'AF6 ' MAT_INST 'SCAL'))
                                        CHAN 'TYPE' 'SCALAIRE' ;
                                FINSI ;
                        FINSI ;
                        SI BOOL.'C*' ;
                                SI (EGA ITYPEF 1) ;
*                                       DENSITE D'ENERGIE POUR LES FLUAGES DONT ON A UNE
*                                       EXPRESSION EXPLICITE DE L'INTEGRATION SUR LE TEMPS
                                        SI (EXIS MAT_INST 'AF0 ') ;
                                                COE1 = ((MINI (CHAF2 + 1.)) + (MAXI (CHAF2 + 1.)))/2. ;
                                                COE2 = ((MINI (CHAF4 + 1.)) + (MAXI (CHAF4 + 1.)))/2. ;
                                                COE3 = ((MINI (CHAF6 + 1.)) + (MAXI (CHAF6 + 1.)))/2. ;
                                                VMI1 = (EXCO ('VMIS' MOD_MEC_R SIGF MAT_INST) 'SCAL')
                                                CHAN 'TYPE' 'SCALAIRE'         ;
                                                ENERM1 = (CHAF2*((CHAF2 + 1.)**(-1.)))*CHAF1*(VMI1**COE1) ;
                                                ENERM2 = (CHAF4*((CHAF4 + 1.)**(-1.)))*CHAF3*(VMI1**COE2) ;
                                                ENERM3 = (CHAF6*((CHAF6 + 1.)**(-1.)))*CHAF5*(VMI1**COE3) ;
                                                ENERM = ENERM1 + ENERM2 + ENERM3 ;
                                        SINON ;
                                                COE1 = ((MINI (CHAF2 + 1.)) + (MAXI (CHAF2 + 1.)))/2. ;
                                                COE2 = ((MINI CHAF3) + (MAXI CHAF3))/2. ;
                                                VMI1 = (EXCO ('VMIS' MOD_MEC_R SIGF MAT_INST) 'SCAL')
                                                CHAN 'TYPE' 'SCALAIRE'     ;
                                                SI ((EGA INST 0. 1.E-10) ET ('<'(COE2 - 1) 0.)) ;
                                                        V1 = 0. ;
                                                SINON ;
                                                        V1 = INST**(COE2 - 1) ;
                                                FINSI ;
                                                ENERM = (CHAF2*((CHAF2 + 1.)**(-1.)))*
                                                                        CHAF1*(VMI1**COE1)*CHAF3*V1 ;
                                        FINSI ;
                                        SI (BOOL.'COQ' ET BOOL.'EL_LIN') ; ENERM = ENERM*MOD_MEC_R EPAICH ; FINSI ;
                                FINSI ;
                                SI (EGA ITYPEF 2) ;
*                                       ON N'A PAS UNE EXPRESSION EXPLICITE DE
*                                       L'INTEGRATION DU FLUAGE SUR LE TEMPS
                                        SIGMOY = 0.5*(SIG1 + SIGF) ;
                                        SI ((EGA IABC 0) ET (NON BOOL.'REPRI')) ;
                                                ENERM = 'ENER' MOD_MEC_R VITDFI SIGMOY ;
                                        SINON ;
                                                ENERM = ENERM + ('ENER' MOD_MEC_R (VITDFI - VDI1) SIGMOY) ;
                                        FINSI ;
                                        SIG11 = SIG1 ; SIG1 = SIGF ; VDI1 = VITDFI ;
                                FINSI ;
                        FINSI ;
*                       FACTEUR AFFECTE A J SI ON CALCULE C*(H)
                        SI BOOL.'C*H' ;
                                CHAR2 = EXTR CHAR1 'MECA' ;
                                COE1 = ((MINI CHAF1) + (MAXI CHAF1)) / 2. ;
                                COE2 = ((MINI CHAF2) + (MAXI CHAF2)) / 2. ;
                                COE3 = ((MINI CHAF3) + (MAXI CHAF3)) / 2. ;
                                N1 = COE2 / COE3 ;
                                SI (EGA INST 0. 1.E-10) ; INST = 1.E-10 ; FINSI ;
                                P1 = PROG 0. 'PAS' (INST / 100.) INST ;
                                P2 = PROG ;
                                REPE BF1 (DIME P1) ;
                                        T1 = EXTR P1 &BF1 ;
                                        V1 = 0. ;
                                        REPE BF2 (DIME CHAR2) ;
                                                E1 = EXTR CHAR2 'EVOL' &BF2 ;
                                                V1 = V1 + ('IPOL' T1 (EXTR E1 'ABSC') (EXTR E1 ORDO)) ;
                                        FIN BF2 ;
                                        P2 = P2 ET (PROG V1) ;
                                FIN BF1 ;
                                E1 = EVOL 'MANU' 'TEMPS' P1 'FORCE' (P2 ** N1) ;
                                FACT1 = EXTR (INTG E1) 1 ;
                                SI (EGA FACT1 0. 1.E-10) ; FACT1 = 1.E+30 ; FINSI ;
                                FACT1 = ((V1 ** N1) / FACT1) ** COE3 ;
                        FINSI ;
                FINSI ;
 
********************************************************
* SI LA COURBE DE TRACTION DEPEND DE LA TEMPERATURE ON *
* CALCULE LA VARIATION DE CONTRAINTES DE VON-MISES LORS*
* D'UNE AUGMENTATION (DETATE) DE LA TEMPERATURE A INST *
********************************************************
*bp 11/08/2011 : on calcule plutot la variation de la limite d elasticite
*                ce qui est moins faux si presence de decharge...
*            => on construit VM1 comm VM2 !
                SI (((DIME MODPLA) '>' 0) ET BOOL.'THER') ;
                        DETATE = 1. ;
                        TEP1 = TEPINT + (MANU 'CHPO' ELTETA 1 'T' DETATE) ;
                        EPS1 = (EXCO VARF 'EPSE') CHAN 'TYPE' 'SCALAIRE' ;
                        MSQ1 = 'MASQ' 'SUPERIEUR' EPS1 1.E-10 ;
                        EPS1 = MSQ1 * EPS1 ;
*rem : on pourrait utiliser BORN dans le futur
*     VMI1 = (CHAN ('VMIS' MOD_MEC_R SIGF MAT_INST)
*                     'TYPE' 'SCALAIRE')*MSQ1 ;
*     DETAVM = VMI1 * 0. ;
                        DETAVM = 0. ;
                        REPETER BCMOD2 NBOBJ ;
                                MODI = TABMOD.&BCMOD2 ;
*       VM1 = REDU VMI1 MODI ;
                                EPS2 = redu EPS1 MODI ;
                                SI (EXIS MODPLA &BCMOD2) ;
                                        SI (EGA MODPLA.&BCMOD2 1) ;
                                                MA1 = VARI 'NUAG' MODI (MATE MODI
                                                                'ECRO' TABTRA.&BCMOD2) TEPINT ;
                                                VM1 = VARI 'NUAG' MODI (EXCO 'ECRO' MA1 'SIGM')
                                                EPS2 'STRESSES' 'SCALAIRE' ;
                                                VM1 = (EXCO VM1 'SIGM' 'SCAL') CHAN 'TYPE' 'SCALAIRE' ;
                                                MA2 = 'VARI' 'NUAG' MODI (MATE MODI
                                                                'ECRO' TABTRA.&BCMOD2) TEP1 ;
*            VM2 = 'VARI' 'NUAG' MODI (EXCO 'ECRO' MA2 SIGM)
*                  (REDU EPS1 MODI) 'STRESSES' 'SCALAIRE' ;
*            VM2 = ((EXCO VM2 SIGM 'SCAL')CHAN 'TYPE' 'SCALAIRE')
*                         * (REDU MSQ1 MODI) ;
                                                VM2 = VARI 'NUAG' MODI (EXCO 'ECRO' MA2 'SIGM')
                                                                EPS2 'STRESSES' 'SCALAIRE' ;
                                                VM2 = (EXCO VM2 SIGM 'SCAL') CHAN 'TYPE' 'SCALAIRE' ;
                                        FINSI ;
                                        SI ((EGA MODPLA.&BCMOD2 2) OU
                                                (EGA MODPLA.&BCMOD2 3)) ;
                                                MA1 = VARI 'NUAG' MODI (REDU MAT_MEC MODI) TEPINT ;
                                                VM1 = CHAN 'STRESSES' MODI (EXCO MA1 'SIGY' 'SCAL') ;
                                                MA2 = VARI 'NUAG' MODI (REDU MAT_MEC MODI) TEP1 ;
*           EPS2 = REDU EPS1 MODI ;
                                                VM2 = CHAN 'STRESSES' MODI (EXCO MA2 'SIGY' 'SCAL') ;
                                                SI (EGA MODPLA.&BCMOD2 2) ;
                                                        HSCAL1 = (EXCO MA1 'H' 'SCAL') CHAN 'TYPE' 'SCALAIRE' ;
                                                        VM1 = VM1 + ((CHAN 'STRESSES' MODI HSCAL1)*EPS2) ;
                                                        HSCAL2 = (EXCO MA2 'H' 'SCAL') CHAN 'TYPE' 'SCALAIRE' ;
                                                        VM2 = VM2 + ((CHAN 'STRESSES' MODI HSCAL2)*EPS2) ;
                                                FINSI ;
*           VM2 = VM2 * (REDU MSQ1 MODI) ;
                                        FINSI ;
                                        SI (EGA (TYPE DETAVM) 'FLOTTANT') ;
                                                DETAVM = ((VM2 - VM1) / DETATE) ;
                                        SINON ;
                                                DETAVM = DETAVM + ((VM2 - VM1) / DETATE) ;
                                        FINSI ;
                                FINSI ;
                        FIN BCMOD2 ;
                FINSI ;
 
 
*******************************************************
**** ENERGIE DE DEFORMATION ELASTIQUE ET PLASTIQUE ****
*******************************************************
***
*** DENSITE D'ENERGIE EN ELASTO OU THERMO-ELASTO-PLASTICITE ET
*** DENSITE D'ENERGIE LIEE A LA VARIATION DE COURBE DE TRACTION
***
                SI (NON BOOL.'C*') ;
                        WELAS = 0.5*('ENER' MOD_MEC_R SIGF ('ELAS' MOD_MEC_R SIGF MAT_INST)) ;
*     SI (BOOL.'PASAPAS' ET (NON BOOL.'DECOUPLAGE')) ;
                        SI (BOOL.'PASAPAS') ;
                                SI (EGA IABC 0) ;
                                        VMI1 = CHAN ('VMIS' MOD_MEC_R SIGF MAT_INST) 'TYPE' 'SCALAIRE' ;
                                        SI (BOOL.'COQ' ET BOOL.'EL_LIN') ; VMI1 = VMI1*MOD_MEC_R EPAICH ; FINSI ;
                                        WPLAS=0.5*VMI1*((EXCO VARF 'EPSE')CHAN 'TYPE' 'SCALAIRE') ;
                                        SI (((DIME MODPLA) '>' 0) ET BOOL.'THER') ;
                                                WVMIS = 0.5*DETAVM*((EXCO VARF 'EPSE')
                                                                        CHAN 'TYPE' 'SCALAIRE') ;
                                        FINSI ;
                                SINON ;
                                        VMI1 = CHAN (0.5*(('VMIS' MOD_MEC_R SIG1 MAT_INST) +
                                                        ('VMIS' MOD_MEC_R SIGF MAT_INST))) 'TYPE' 'SCALAIRE' ;
                                        SI (BOOL.'COQ' ET BOOL.'EL_LIN') ; VMI1 = VMI1*MOD_MEC_R EPAICH ; FINSI ;
                                        WPLAS = WPLAS + (VMI1*((EXCO (VARF - VAR1) 'EPSE')
                                                                CHAN 'TYPE' 'SCALAIRE')) ;
                                        SI (((DIME MODPLA) '>' 0) ET BOOL.'THER') ;
                                                WVMIS = WVMIS + ((0.5*(DETAV1 + DETAVM))*
                                                                        ((EXCO (VARF - VAR1) 'EPSE')
                                                                        CHAN 'TYPE' 'SCALAIRE') ) ;
                                        FINSI ;
                                FINSI ;
                                ENERM = WELAS + WPLAS ;
                                SIG11 = SIG1 ; SIG1 = SIGF*1. ; VAR11 = VAR1 ; VAR1 = VARF*1. ;
                                SI (((DIME MODPLA) '>' 0) ET BOOL.'THER') ;
                                        DETAV1 = DETAVM ;
                                FINSI ;
                        SINON ;
                                ENERM = WELAS ;
                        FINSI ;
                FINSI ;
 
 
 
***************************************************
*********** APPEL A LA PROCEDURE G_CALCUL *********
***************************************************
 
*               REMPLISSAGE DE OBJUTI
                OBJUTI.'&BOUCMIX' = &BOUCMIX ;
                OBJUTI.'IABC' = IABC ;
                OBJUTI.'&BOUCEXT' = &BOUCEXT ;
                OBJUTI.'INST' = INST ;
                OBJUTI.'C_MATE' = C_MATE ;
                OBJUTI.'FACT1' = FACT1 ;
                OBJUTI.'MAT_INST' = MAT_INST ;
                OBJUTI.'RIGTOT' = RIGTOT ;
                OBJUTI.'ENERM' = ENERM ;
                OBJUTI.'WVMIS' = WVMIS ;
                OBJUTI.'TEPINT' = TEPINT ;
                OBJUTI.'PREINT' = PREINT ;
                OBJUTI.'DEFI' = DEFI ;
*               PRESSION SUR LES LEVRES
                SI BOOL.'PRES_FISS' ;
                        OBJUTI.'MODE_PRESSION_FISSURE'= MODPF ;
                        OBJUTI.'PRESSION_FISSURE' = PNF ;
                FINSI ;
                OBJUTI.'DEPINT' = DEPINT ;
                OBJUTI.'SIGF' = SIGF ;
                OBJUTI.'SIG1' = SIG11 ;
                OBJUTI.'VARF' = VARF ;
*               DYNAMIQUE
                OBJUTI.'VITF' = VITF ;
                OBJUTI.'ACCF' = ACCF ;
*               DECOUPLAGE
                OBJUTI.'MOTMIX' = MOTMIX  ;
                OBJUTI.'MOTMIA' = MOTMIA ;
                OBJUTI.'A_PREI' = A_PREI ;
                OBJUTI.'A_DEPI' = A_DEPI ;
                OBJUTI.'A_SIGF' = A_SIGF ;
                OBJUTI.'A_DEPGR'= A_DEPGR ;
*               FROTTEMENT
                SI BOOL.'FROT' ;
                        OBJUTI . 'WDEP'  = WDEP ;
                        OBJUTI . 'SIGCON' = SIGCON ;
                FINSI ;
 
*               APPEL A G_CALCUL
                G_CALCUL SUPTAB OBJUTI BOOL ;
 
        FIN BOUCMIX ;
* FIN DE BOUCLE SUR LES INTEGRALES A CALCULER ========================*
 
 
****************************************************
****** ON RECUPERE LA CONFIGURATION INITIALE *******
****************************************************
 
        SI (BOOL.'PASAPAS' ET BOOL.'ROT_RIG') ;
                FORM CONFIG0 ;
        FINSI ;
 
 
****************************************************
******* FIN DE BOUCLE SUR LES PAS DE CALCUL ********
****************************************************
FIN BOUCEXT ;
 
 
****************************************************
** STOCKAGE DES RESULTATS DANS L OBJET EVOLUTIONS **
****************************************************
* en plus de ce qui existe dans SUPTAB.'RESULTATS'
* et dans CHPO_RESULTATS (fait dans G_calcul)
SI (BOOL.'PASAPAS' ET (NON BOOL.'PERSO1')) ;
        IND1 = INDE (SUPTAB.'RESULTATS') ;
 
*       Cas 2D *******************************************
        SI (EGA GDIME 2) ;
                TITR CHA1 ;
                SI BOOL.'DECOUPLAGE' ;
                        REPE BB1 (DIME IND1) ;
                                MOT1 = IND1.&BB1 ; PT = PROG ; PG = PROG ;
                                IND2 = INDE (SUPTAB.'RESULTATS'.MOT1) ;
                                REPE BB2 (DIME IND2) ;
                                        P1 = &BB2 - 1 ;
                                        PT = PT ET (PROG SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.P1) ;
                                        PG = PG ET (PROG SUPTAB.'RESULTATS'.MOT1.P1) ;
                                FIN BB2 ;
                                E1 = EVOL 'MANU' 'TEMPS' PT MOTTI PG ;
                                SUPTAB.'EVOLUTION_RESULTATS'.MOT1 = E1 ;
                        FIN BB1 ;
                SINON ;
                        PT = PROG ; PG = PROG ;
                        REPE BB1 (DIME IND1) ;
                                P1 = &BB1 - 1 ;
                                PT = PT ET (PROG SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.P1) ;
                                PG = PG ET (PROG SUPTAB.'RESULTATS'.P1) ;
                        FIN BB1 ;
                        E1 = EVOL 'MANU' 'TEMPS' PT MOTTI PG ;
                        SUPTAB.'EVOLUTION_RESULTATS' = E1 ;
                FINSI ;
        FINSI ;
 
* Cas 3D *******************************************
* Rem BP :
* !!! Attention passer ici lorsque la fissure propage doit conduire
*     a des erreurs, puisque les points du front changent ...!!!
*     Il faudrait a terme supprimer cette mise en forme des resultats
*     ainsi que celle utilisant la table RESULTATS (cf g_calcul).
*     Seul CHPO_RESULTATS semblent perenne pour la porpagation.
        SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
                SI BOOL.'DECOUPLAGE' ;
                        REPE BB1 (DIME IND1) ;
                                MOT1 = IND1.&BB1 ;
                                IND2 = INDE (SUPTAB.'RESULTATS'.MOT1) ;
                                IND3 = INDE (SUPTAB.'RESULTATS'.MOT1.(IND2.1)) ;
                                REPE BB2 (DIME IND3) ;
                                        PM = IND3.&BB2 ; PT = PROG ; PG = PROG ;
                                        SI (EGA &BB2 (DIME IND3)) ;
                                                CHA2 = CHAI ' (Global)' ;
                                        SINON ;
*              CHA2 = CHAI ' (Pt ' ('NOEUD' PM) ')' ;
                                                CHA2 = CHAI ' (Pt ' (&BB2) ')' ;
                                        FINSI ;
                                        TITR (CHAI CHA1 CHA2) ;
                                        REPE BB3 (DIME IND2) ;
                                                P1 = &BB3 - 1 ;
                                                PT = PT ET (PROG SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.P1) ;
                                                PG = PG ET (PROG SUPTAB.'RESULTATS'.MOT1.P1.PM) ;
                                        FIN BB3 ;
                                        E1 = EVOL 'MANU' 'TEMPS' PT MOTTI PG ;
                                        SUPTAB.'EVOLUTION_RESULTATS'.MOT1.PM = E1 ;
                                FIN BB2 ;
                        FIN BB1 ;
                SINON ;
                        IND2 = INDE (SUPTAB.'RESULTATS'.(IND1.1)) ;
                        REPE BB1 (DIME IND2) ;
                                PM = IND2.&BB1 ; PT = PROG ; PG = PROG ;
                                SI (EGA &BB1 (DIME IND2)) ;
                                        CHA2 = CHAI ' (Global)' ;
                                SINON ;
*            CHA2 = CHAI ' (Pt ' ('NOEUD' PM) ')' ;
                                        CHA2 = CHAI ' (Pt ' (&BB1) ')' ;
                                FINSI ;
                                TITR (CHAI CHA1 CHA2) ;
                                REPE BB2 (DIME IND1) ;
                                        P1 = &BB2 - 1 ;
                                        PT = PT ET (PROG SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.P1) ;
                                        PG = PG ET (PROG SUPTAB.'RESULTATS'.P1.PM) ;
                                FIN BB2 ;
                                E1 = EVOL 'MANU' 'TEMPS' PT MOTTI PG ;
                                SUPTAB.'EVOLUTION_RESULTATS'.PM = E1 ;
                        FIN BB1 ;
                FINSI ;
        FINSI ;
 
* Cas coque *******************************************
        SI BOOL.'COQ' ;
                IND2 = INDE (SUPTAB.'RESULTATS'.(IND1.1)) ;
                REPE BB1 (DIME IND2) ;
                        PM = MOT IND2.&BB1 ; PT = PROG ; PG = PROG ;
*        CHA2 = CHAI ' (' PM ')' ;
                        CHA2 = CHAI ' (Pt ' (&BB1) ')' ;
                        TITR (CHAI CHA1 CHA2) ;
                        REPE BB2 (DIME IND1) ;
                                P1 = &BB2 - 1 ;
                                PT = PT ET (PROG SUPTAB.'SOLUTION_PASAPAS'.'TEMPS'.P1) ;
                                PG = PG ET (PROG SUPTAB.'RESULTATS'.P1.PM) ;
                        FIN BB2 ;
                        E1 = EVOL 'MANU' 'TEMPS' PT MOTTI PG ;
                        SUPTAB.'EVOLUTION_RESULTATS'.PM = E1 ;
                FIN BB1 ;
        FINSI ;
 
FINSI ;
 
 
********************************************************
**** STOCKAGE POUR UNE EVENTUELLE REPRISE DE CALCUL ****
********************************************************
SI BOOL.'PASAPAS' ;
        SUPTAB.'OBJ1' = MOT SUPTAB.'OBJECTIF' ;
        SUPTAB.'IABC' = IABC ;
        SUPTAB.'MAT_INST' = MAT_INST ;
        SUPTAB.'END1' = ENERM ;
        SI (((DIME MODPLA) '>' 0) ET BOOL.'THER') ;
                SUPTAB.'ENV1' = WVMIS ;
        FINSI ;
        SI (EGA ITYPEF 2) ;
                SUPTAB.'VDI1' = VDI1 ;
        FINSI ;
FINSI ;
 
********************************************************
************ ENLEVEMENT DES OBJETS INUTILES ************
********************************************************
SI (EXIS SUPTAB 'COUCHE') ;
      SUPTAB.'COU1' = SUPTAB.'COUCHE' ;
FINSI ;
 
*bp: soyons coherent... CHAMP_THETA est deja renseigne
SUPTAB.'CHAMP_THET1' = SUPTAB.'CHAMP_THETA' ;
OTER SUPTAB 'CHAMP_THETA' ;
* UTILTETA sera pratique pour la propagation xfem
SUPTAB.'UTILTET1' = UTILTETA ;
* ELTETA sera pratique pour les tests de reprise
SUPTAB.'ELTET1' = ELTETA ;
 
FINPROC ;