Procédures | Cast3M

* G_THETA   PROCEDUR  JB251061  22/08/09    21:15:02     11426          
DEBPROC G_THETA SUPTAB*'TABLE';
* =============================================================================
*              PROCEDURE DE MISE EN OEUVRE DE LA METHODE G-THETA
*              -------------------------------------------------
*
* DESCRIPTION : CETTE PROCEDURE PERMET DE CALCULER DES INTEGRALES DE MECANIQUE
*               DE LA RUPTURE. CES INTEGRALES SONT :
*                  1) LE TAUX DE RESTITUTION D'ENERGIE G (OU INTEGRALE DE
*                     CONTOUR J) EN ELASTO-PLASTICITE OU ELASTO-DYNAMIQUE;
*                  2) dJ/dA EN ELASTOPLASTICITE;
*                  3) C* POUR LE FLUAGE SECONDAIRE STATIONNAIRE;
*                  4) C*H POUR LE FLUAGE PRIMAIRE SOUS CHARGEMENT RADIAL.
*
*               IL EST EGALEMENT POSSIBLE DE CALCULER LES FACTEURS D'INTENSITE
*               DES CONTRAINTES (KI, KII, KIII) VIA L'OPTION 'DECOUPLAGE'.
* =============================================================================
 
* 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;
 
* 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;
NMESS = OBJUTI.'NMESS';
 
 
* LECTURE DES DONNEES FOURNIES
* ****************************
 
GDIME = OBJUTI.'DIMENSION';
GMODE = OBJUTI.'MODE';
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';
 
* 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 (EXIS SUPTAB 'TAB_THETA');
    OTER SUPTAB 'TAB_THETA';
FINSI;
SI (EXIS SUPTAB 'TAB_PI');
    OTER SUPTAB 'TAB_PI';
FINSI;
SI (EXIS SUPTAB 'COUCHE');
    MESS 'CHAMP_THETA NON FOURNI PAR L''UTILISATEUR';
    SI (EXIS SUPTAB 'CHAMP_THETA');
* CHAMP_THETA ET COUCHE SONT TOUS DEUX FOURNIS, ON ECRASE CHAMP_THETA
        MESS 'Nombre de couches donne => on ne tient pas compte du champ fourni'/3;
        OTER SUPTAB 'CHAMP_THETA';
    FINSI;
SINON;
    MESS 'CHAMP_THETA FOURNI PAR L UTILISATEUR';
FINSI;
SI BOOL.'XFEM';
* ON APPELLE CH_TETX POUR CALCULER CHAMP_THETA
    CH_THETX SUPTAB OBJUTI BOOL;
SINON;
* ON APPELLE CH_TETA POUR CALCULER CHAMP_THETA
    CH_THETA SUPTAB OBJUTI BOOL;
FINSI;
 
* DETERMINATION DE ELTETA
* ELTETA1 = MAILLAGE OU TETA N EST PAS NUL + 1 COUCHE
CHTHETA = SUPTAB.'CHAMP_THETA';
SI (NEG (TYPE CHTHETA) 'CHPOINT');
    CHTHETA = CHTHETA.'GLOBAL';
FINSI;
* UU = EXTR CHTHETA 'MAILLAGE';
NTHETA = (PSCA CHTHETA CHTHETA MUI MUI)**0.5;
ELTETA1 = MAILLAGE ELEM 'APPU' 'LARG' (NTHETA POIN 'SUPERIEUR' 0.);
SI (NON BOOL.'XFEM');
    ELTETA1 = MAILLAGE ELEM 'APPU' 'LARG' ELTETA1;
FINSI;
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;
SI BOOL.'TRAC';
    VCHTHETA = VECT CHTHETA 'DEPL' 'BLEU';
    TRAC VCHTHETA (MAILLAGE ET M_FRONT) 'TITR' 'CHAMP_THETA';
FINSI;
* ON STOCKE LES DIRECTIONS DANS UTILTET1 POUR PROPAGATION EN XFEM
* DIRECTION DE PROPAGATION : DIR1
* DIRECTION TANGENTE AU FRONT : DIR2
* DIRECTION DE CISAILLEMENT SI SEPARATION DE MODES : DIR3
SUPTAB.'UTILTET1' = TABL;
REPE I 3;
    MDIR = CHAI 'DIRECTION' &I;
    SI (EXIS OBJUTI MDIR);
        SUPTAB.'UTILTET1'.MDIR = OBJUTI.MDIR;
    FINSI;
FIN I;
 
 
* 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;
 
* ELTETA SERA PRATIQUE POUR LES TESTS DE REPRISE
OBJUTI.'ELTETA' = ELTETA;
SUPTAB.'ELTET1' = ELTETA;
 
 
* 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 OBJUTI.'DIRECTION1';
                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 = ('&lt;EG' ('DIST' P1 PDIR1      ) 1.E-6) 'OU'
                      ('&lt;EG' ('DIST' 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;
 
* ON DETERMINE SI ON A DES GRADIENTS DE PROPRIETES (THERMO-)ELASTIQUES
    MPROP = MOTS 'YOUN' 'NU';
    SI BOOL.'THER';
        MPROP = MPROP ET 'ALPH';
    FINSI;
    REPE IPROP (DIME MPROP);
        MCOMP = EXTR MPROP &IPROP;
        MGRAD = CHAI 'GRAD' MCOMP;
        PRO1 = EXCO MATEI MCOMP;
        TYP1 = TYPE (EXTR PRO1 MCOMP 1 1 1);
        SI (EGA TYP1 'EVOLUTIO');
            BOOL.MGRAD = VRAI;
        SINON;
            DPRO1 = (MAXI PRO1) - (MINI PRO1);
            CRI1 = (MAXI PRO1 'ABS') * 1.E-10;
            SI (DPRO1 > CRI1);
                BOOL.MGRAD = VRAI;
            FINSI;
        FINSI;
    FIN IPROP;
 
*     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);
 
 
* METHODE DE CALCUL DES CHAMPS AUXILIAIRES SI DECOUPLAGE (VOIR G_AUX)
* *******************************************************************
 
SI BOOL.'DECOUPLAGE';
    SI (BOOL.'DANS' ET (NEG GDIME 2));
        MESS 'ERREUR : CAS BI-MATERIAU TRAITABLE UNIQUEMENT EN 2D';
        ERRE 21;
    FINSI;
    SI (NON (EXIS SUPTAB 'METH_AUX'));
        MESS;
        MESS 'L''indice METH_AUX n''est pas fourni => choix par defaut'
              /NMESS;
        SI BOOL.'DANS';
* PAR DEFAUT ON UTILISE LA METHODE U-ANALYTIQUE DANS LE CAS BI-MATERIAU 2D
            SUPTAB.'METH_AUX' = 'UANA';
        SINON;
* PAR DEFAUT ON UTILISE LA METHODE G-ANALYTIQUE DANS LE CAS MONO-MATERIAU
            SUPTAB.'METH_AUX' = 'GANA';
        FINSI;
    SINON;
        SI (BOOL.'DANS' ET (NEG SUPTAB.'METH_AUX' 'UANA'));
* ON UTILISE TOUJOURS LA METHODE U-ANALYTIQUE POUR UN BI-MATERIAU
            SUPTAB.'METH_AUX' = 'UANA';
            MESS 'ATTENTION : SEULE LA METHODE UANA EST UTILISABLE POUR';
            MESS '            LE CAS D''UN BI-MATERIAU => ON L''UTILISE';
        FINSI;
        SAUT 'LIGNE';
    FINSI;
* VERIFICATION QUE LA METHODE EST UTILISABLE
    METH_AUX = SUPTAB.'METH_AUX';
    SI ((NEG METH_AUX 'GANA') ET (NEG METH_AUX 'UANA')
            ET (NEG METH_AUX 'MECA'));
        MESS 'ERREUR : ON NE CONNAIT PAS LA METHODE DEMANDEE POUR CALCULER';
        MESS '         LES CHAMPS AUXILIAIRES';
        ERRE 21 ; QUIT G_THETA;
    FINSI;
    SI (EGA METH_AUX 'GANA');
        SI (NON BOOL.'XFEM');
            VERR = VALE 'ERRE';
            OPTI 'ERRE' 'IGNO';
            GEO2 = VERS SUPTAB.'LEVRE_SUPERIEURE';
            GEO2 = VERS SUPTAB.'LEVRE_INFERIEURE';
* INSTRUCTION BIDON CAR SINON LA DETECTION D'ERREUR NE SE PASSE PAS BIEN...
            VAR = VRAI;
            OPTI 'ERRE' VERR;
            SI (EGA (TYPE GEO2) (MOT 'ANNULE'));
                MESS 'ERREUR : LES LEVRES NE SONT PAS ORIENTEES CORRECTEMENT';
                ERRE 21 ; QUIT G_THETA;
            FINSI;
        FINSI;
    FINSI;
    SI ((EGA METH_AUX 'MECA') ET (BOOL.'XFEM' OU (EGA GDIME 2)));
        MESS 'ERREUR : ON NE PEUT UTILISER LA METHODE MECANIQUE QUE DANS LE';
        MESS '         CAS 3D AVEC DES ELEMENTS STANDARDS';
        ERRE 21 ; QUIT G_THETA;
    FINSI;
    SI ((EGA METH_AUX 'UANA') ET (EGA GDIME 3));
        MESS 'ERREUR : ON NE PEUT UTILISER LA METHODE U-ANALYTIQUE';
        MESS '         QUE DANS LE CAS 2D';
        ERRE 21 ; QUIT G_THETA;
    FINSI;
FINSI;
 
 
* CAS IMPOSSIBLE A TRAITER
* ************************
 
SI (EXIS SUPTAB 'MODELES_COMPOSITES');
    SI (BOOL.'DECOUPLAGE' ET BOOL.'DANS');
        SI (NON BOOL.'PARAL');
            MESS 'ERREUR : ON NE PEUT PAS ENCORE DECOUPLER LES MODES';
            MESS '         EN PRESENCE D''UNE DISCONTINUITE MATERIELLE';
            MESS '         SI LA FISSURE N APPARTIENT PAS A L INTERFACE';
            ERRE 21 ; QUIT G_THETA;
        FINSI;
        SI (EGA GDIME 3);
            MESS 'ERREUR : ON NE PEUT PAS ENCORE DECOUPLER LES MODES';
            MESS '         EN PRESENCE D''UNE DISCONTINUITE MATERIELLE';
            MESS '         DANS LE CAS 3D.';
            ERRE 21 ; QUIT G_THETA;
        FINSI;
    FINSI;
FINSI;
 
 
 
* =============================================================================
 
* PREREQUIS POUR EFFECTUER LES CALCULS
* ------------------------------------
 
* 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 = ZERO MOD_MEC_R 'VARINTER' ;;
    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.'MODCOU' = MODCOU;
OBJUTI.'TABMOD' = TABMOD;
OBJUTI.'LINTER' = LINTER;
OBJUTI.'MODPLA' = MODPLA;
OBJUTI.'ITYPEF' = ITYPEF;
OBJUTI.'NBG' = NBG;
* 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 ((EGA GDIME 3) OU BOOL.'PASAPAS' OU BOOL.'DECOUPLAGE');
        SUPTAB.'RESULTATS' = TABL;
    FINSI;
    SI BOOL.'PASAPAS';
        SI (EGA GDIME 3);
            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 (BOOL.'COQ' ET BOOL.'PASAPAS');
                SUPTAB.'EPAISSEUR_RESULTATS'.MODE_RUPT = TABL;
            FINSI;
        FIN IRUPT;
    FINSI;
FINSI;
* DECLARATION DES TABLES POUR CHPO_RESULTATS ET CHAM_RESULTATS
SI (NON (EXIS SUPTAB 'CHPO_RESULTATS'));
    SI BOOL.'PASAPAS';
        SUPTAB.'CHPO_RESULTATS' = TABL;
    SINON;
        SUPTAB.'CHPO_RESULTATS' = VIDE 'CHPOINT'/'DISCRET';
    FINSI;
FINSI;
SI (NON (EXIS SUPTAB 'CHAM_RESULTATS'));
    SI BOOL.'PASAPAS';
        SUPTAB.'CHAM_RESULTATS' = TABL;
    SINON;
        SUPTAB.'CHAM_RESULTATS' = VIDE 'MCHAML';
    FINSI;
FINSI;
 
 
* =============================================================================
 
* APPEL A G_AUX SI DECOUPLAGE
* --------------------------
 
SI BOOL.'DECOUPLAGE';
    OBJUTI.'MAT_INST' = MAT_MEC;
    CH_AUX = G_AUX SUPTAB OBJUTI BOOL;
    SI (EGA (TYPE CH_AUX) (MOT 'ANNULE'));
        MESS 'ERREUR : G_AUX A RENCONTRE UN PROBLEME';
        QUIT G_CALCUL;
    FINSI;
    SUPTAB.'CH_AUX' = CH_AUX;
FINSI;
 
* APPEL A G_CALCUL POUR EFFECTUER LES CALCULS ET ENREGISTRER LES RESULTATS
* ------------------------------------------------------------------------
 
G_CALCUL SUPTAB OBJUTI BOOL;
 
* MESSAGE DE FIN DE LA PROCEDURE
SI BOOL.'MESS';
    SAUT 'LIGNE';
    MESS '-------------------' 'FIN DE LA PROCEDURE G_THETA'
    '---------------------';
    SAUT 'LIGNE';
FINSI;
 
FINPROC;