Procédures | Cast3M

* CH_THETA  PROCEDUR  OF166741  25/10/02    21:15:02     12378          
* =============================================================================
*                    PROCEDURE DE CALCUL DU CHAMP THETA/PI
*                    -------------------------------------
*
* DESCRIPTION : DETERMINE UN CHPOINT DE NORME CONSTANTE A L'INTERIEUR D'UNE
*               COURONNE ENTOURANT LE FRONT DE FISSURE ET NUL A L'EXTERIEUR DE
*               CETTE COURONNE. LE CHPOINT THETA AINSI DEFINI REPRESENTE LA
*               DIRECTION DE PROPAGATION EVENTUELLE DE LA FISSURE.
* =============================================================================
DEBP CH_THETA SUPTAB*TABLE OBJUTI*'TABLE' BOOL*'TABLE' ;
 
* ON DETERMINE CE QUE L'ON CALCULE
SI (NON (EXIS SUPTAB 'CHAMP_THETA')) ;
    CALCUL = VRAI ;
    RESULT = MOT 'THETA' ;
SINON ;
    CALCUL = FAUX ;
    SI (NON (EXIS SUPTAB 'TAB_THETA')) ;
        RESULT = MOT 'THETA' ;
    SINON ;
        SI BOOL.'DJ/DA' ;
            SI (NON (EXIS SUPTAB 'CHAMP_PI')) ;
                CALCUL = VRAI ;
                RESULT = MOT 'PI' ;
            SINON ;
                SI (NON (EXIS SUPTAB 'TAB_PI')) ;
                    RESULT = MOT 'PI' ;
                SINON ;
                    RESULT = MOT 'RIEN' ;
                FINSI ;
            FINSI ;
        SINON ;
            RESULT = MOT 'RIEN' ;
        FINSI ;
    FINSI ;
FINSI ;
* SI RESULT = RIEN C'EST QU'ON A DEJA TOUT CE QU'IL FAUT
SI (EGA RESULT 'RIEN') ;
    QUIT CH_THETA ;
FINSI ;
 
* RECUPERATION DE CERTAINES DONNEES
GDIME = OBJUTI.'DIMENSION' ;
MAILLAGE = SUPTAB.'MAILLAGE' ;
CRACK = SUPTAB.'FISSURE' ;
FRON1 = SUPTAB.'FRONT_FISSURE' ;
MOD_MEC = OBJUTI.'MOD_MEC' ;
* QUELQUES MOTS UTILES
* (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) ;
    MU3 = EXTR MUI 3 ; 
    MF3 = EXTR MFI 3 ;
FINSI ;
* VECTEUR NUL
SI (EGA GDIME 2) ;
    VNUL = 0. 0. ;
SINON ;
    VNUL = 0. 0. 0. ;
FINSI ;
* NOEUDS POUR LESQUELS ON VEUT FAIRE LE CALCUL
SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
    SI (EXIS SUPTAB 'NOEUDS_AVANCES') ;
        NOAV = SUPTAB.'NOEUDS_AVANCES' ;
    SINON ;
        NOAV = FRON1 ;
    FINSI ;
FINSI ;
 
 
* =============================================================================
*                   PARTIE 1 : CALCUL DU CHAMP THETA OU PI
*                   --------------------------------------
 
* I - COMPATIBILITE DES DONNEES
* -----------------------------
 
* DEFINITION DU MAILLAGE ET DU NOMBRE DE NOEUDS
SI (EXIS SUPTAB 'MAILLAGE') ;
    MAILLAGE = SUPTAB.'MAILLAGE' ;
    NB1 = NBNO (CHAN MAILLAGE 'POI1') ;
SINON ;
    MESS 'ERREUR : ON N A PAS TROUVE DANS LA TABLE L''INDICE ''MAILLAGE''' ;
    QUIT CH_THETA ;
FINSI ;
M_FISS = ELEM MAILLAGE 'APPUYE' 'LARGEMENT' SUPTAB.'FRONT_FISSURE' ;
 
* VERIFICATION QUE L'EPAISSEUR EST DONNEE POUR LES COQUES
SI (BOOL.'COQ' ET (NON (EXIS SUPTAB 'EPAISSEUR'))) ;
    MESS 'ERREUR : L EPAISSEUR DE LA COQUE N EST PAS DONNEE' ;
    QUIT CH_THETA ;
FINSI ;
 
* VERIFICATIONS SUR LA FISSURE :
* ******************************
* DEFINITION DE LA FISSURE
SI (NON (EXIS SUPTAB 'FISSURE')) ;
    MESS 'ERREUR : LA FISSURE DU PROBLEME N EST PAS DONNEE' ;
    QUIT CH_THETA ;
SINON ;
    CRACK = SUPTAB.'FISSURE' ;
FINSI ;
* VERIFICATION QUE LA FISSURE EST DE TYPE MAILLAGE
SI (NEG (TYPE CRACK) 'MAILLAGE') ;
    MESS 'ERREUR : LA FISSURE DOIT ETRE UN OBJET DE TYPE MAILLAGE' ;
    QUIT CH_THETA ;
FINSI ;
* VERIFICATION QU'IL N'Y A PAS DE NOEUDS DOUBLES
NB2 = NBNO (CHAN (CRACK ET MAILLAGE) 'POI1') ;
SI (NEG NB1 NB2) ;
    MESS 'ERREUR : IL Y A DES NOEUDS DOUBLES ENTRE' ;
    MESS '         LE MAILLAGE ET LA FISSURE' ;
    QUIT CH_THETA ;
FINSI ;
* VERIFICATION QUE LA FISSURE EST UNE LIGNE EN 2D OU 3D COQUE
* ET UNE SURFACE EN 3D MASSIF
LMFISS = ELEM CRACK 'TYPE' ;
LMLIGN = MOTS 'SEG2' 'SEG3' ;
LMSURF = MOTS 'TRI3' 'TRI6' 'QUA4' 'QUA8' ;
SI ((EGA GDIME 2) OU ((EGA GDIME 3) ET BOOL.'COQ')) ;
    SI (NON (EXIS LMLIGN LMFISS 'ET')) ;
        MESS 'ERREUR : EN 2D OU ELEMENTS DE COQUE MINCE' ;
        MESS '         LA FISSURE DOIT ETRE UNE LIGNE' ;
        QUIT CH_THETA ;
    FINSI ;
FINSI ;
SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
    SI (NON (EXIS LMSURF LMFISS 'ET')) ;
        MESS 'ERREUR : EN 2D OU ELEMENTS DE COQUE MINCE' ;
        MESS '         LA FISSURE DOIT ETRE UNE LIGNE' ;
        QUIT CH_THETA ;
    FINSI ;
FINSI ;
 
* VERIFICATIONS SUR LE FRONT DE FISSURE :
* ***************************************
* VERIFICATION QUE LE FRONT EST FOURNI
SI (NON (EXIS SUPTAB 'FRONT_FISSURE')) ;
    MESS 'ERREUR : LE FRONT DE LA FISSURE N''EST PAS DONNE' ;
    QUIT CH_THETA ;
FINSI ;
NB2 = NBNO (CHAN (SUPTAB.'FRONT_FISSURE' ET MAILLAGE) 'POI1') ;
SI (NEG NB1 NB2) ;
    MESS 'ERREUR : IL Y A DES NOEUDS DOUBLES ENTRE LE' ;
    MESS '         MAILLAGE ET LE FRONT DE LA FISSURE' ;
    QUIT CH_THETA ;
FINSI ;
* VERIFICATION QUE LE FRONT DE FISSURE EST UNE LIGNE EN 3D MASSIF
* ET UN POINT EN 2D OU 3D COQUE 
MFRONT = TYPE SUPTAB.'FRONT_FISSURE' ;
SI ((GDIME EGA 3) ET (NON BOOL.'COQ')) ;
    SI (NEG MFRONT 'MAILLAGE') ;
        MESS 'ERREUR : EN 3D AVEC ELEMENTS MASSIFS LE FRONT' ;
        MESS '         DOIT ETRE DE TYPE MAILLAGE.' ;
        QUIT CH_THETA ;
    FINSI ;
    LMFRONT = SUPTAB.'FRONT_FISSURE' ELEM 'TYPE' ;
    SI (NON (EXIS LMLIGN LMFRONT 'ET')) ;
        MESS 'ERREUR : EN 3D AVEC ELEMENTS MASSIFS LE FRONT' ;
        MESS '         DE LA FISSURE DOIT ETRE UNE LIGNE' ;
        QUIT CH_THETA ;
    FINSI ;
FINSI ;
SI ((GDIME EGA 2) 'OU' ((GDIME EGA 3) ET BOOL.'COQ')) ;
    SI (NON (EGA MFRONT 'POINT')) ;
        MESS 'ERREUR : EN 2D OU ELEMENTS EN COQUE MINCE LE' ;
        MESS '         FOND DE LA FISSURE DOIT ETRE UN POINT' ;
        QUIT CH_THETA ;
    FINSI ;
FINSI ;
* VERIFICATION QU'IL N'Y A PAS DE NOEUDS DOUBLES ENTRE LE FRONT ET LA FISSURE
NB1 = NBNO (CHAN CRACK 'POI1') ;
NB2 = NBNO (CHAN (SUPTAB.'FRONT_FISSURE' ET CRACK) 'POI1') ;
SI (NEG NB1 NB2) ;
    MESS 'ERREUR : IL Y A DES NOEUDS DOUBLES ENTRE LE FRONT' ;
    MESS '         DE LA FISSURE ET LA FISSURE ELLE MEME' ;
    QUIT CH_THETA ;
FINSI ;
 
* VERIFICATION QUE LE NOMBRE DE COUCHES EST FOURNI
SI (EXIS SUPTAB 'COUCHE') ;
    COUCHE = SUPTAB.'COUCHE' ;
SINON ;
* SINON ON DOIT AVOIR FOURNI CHAMP_THETA ET ON DETERMINE
* ALORS COUCHE A PARTIR DE CELUI-CI
    SI (EXIS SUPTAB 'CHAMP_THETA') ;
        THETA = SUPTAB.'CHAMP_THETA' ;
        NTHETA = (PSCA THETA THETA MUI MUI)**0.5 ;
        THSUPP = NTHETA POIN 'SUPERIEUR' 0. ;
        THSUPP = MAILLAGE ELEM 'APPUYE' 'LARGEMENT' THSUPP ;
        COUCHE = 0 ;
        MAIL1 = FRON1 ;
        SI (EGA (TYPE MAIL1) 'POINT') ;
            MAIL1 = MANU 'POI1' MAIL1 ;
        FINSI ;
        REPE ICOUCH ;
            COUCHE = COUCHE + 1 ;
            MAIL2 = THSUPP ELEM 'APPUYE' 'LARGEMENT' MAIL1 ;
            DIFF1 = DIFF MAIL2 THSUPP ;
            DIFF2 = DIFF MAIL1 MAIL2 ;
            NCRIT = (NBNO DIFF1) * (NBNO DIFF2) ;
            SI ((EGA NCRIT 0)) ;
                QUIT ICOUCH ;
            FINSI ;
            MAIL1 = MAIL2 ;
        FIN ICOUCH ;
        LIST COUCHE ;
    SINON ;
        MESS 'ERREUR : IL FAUT SOIT LE NOMBRE DE COUCHES SOIT UN CHAMP THETA' ;
        ERRE 21 ;
    FINSI ;
FINSI ;
 
SI CALCUL ;
 
* VERIFICATIONS UNIQUEMENT SI CALCUL DU CHAMP GLOBAL
 
* CAS 3D : VERIFICATIONS EN CAS DE TUYAU DROIT ET COUDE :
* *******************************************************
* TTD = TRANSLATION TUYAUTERIE DROITE
* RTD = ROTATION TUYAUTERIE DROITE
* RC = ROTATION COUDE
* DEFINITION DE BOOLEENS UTILES
    LCHTRAN = EXIS SUPTAB 'CHPOINT_TRANSFORMATION' ;
    LOPERA = EXIS SUPTAB 'OPERATEUR' ;
    LPOINT1 = EXIS SUPTAB 'POINT_1' ;
    LPOINT2 = EXIS SUPTAB 'POINT_2' ;
    LPOINT3 = EXIS SUPTAB 'POINT_3' ;
    SI (EGA GDIME 3) ;
        SI (LPOINT1 ET LPOINT2 ET LPOINT3) ;
* LES 3 POINTS SONT DONNES
            SI (LCHTRAN OU LOPERA) ;
* SI ON DONNE LES 3 POINTS PLUS L'UN DE CES 2 INDICES ON NE SAIT PAS QUOI FAIRE
                MESS 'ERREUR : DONNEES IMCOMPATIBLES. CONSULTEZ LA NOTICE;' ;
                QUIT CH_THETA ;
            SINON ;
* ON A UNIQUEMENT LES 3 POINTS DONC LE CAS EST 'TTD'
                BOOL.'TTD' = VRAI ;
                BOOL.'RTD' = FAUX ;
                BOOL.'RC' = FAUX ;
                PAXEZ1 = SUPTAB.'POINT_1';
                PAXEZ2 = SUPTAB.'POINT_2';
                PAXEZ3 = SUPTAB.'POINT_3';
            FINSI ;
        SINON ;
* IL MANQUE DONC AU MOINS UN POINT
            SI (LPOINT1 ET LPOINT2) ;
* LES POINTS 1 ET 2 SONT DONNES
                BOOL.'TTD' = FAUX ;
                POINT_1 = SUPTAB.'POINT_1';
                POINT_2 = SUPTAB.'POINT_2';
                SI (LCHTRAN ET LOPERA) ;
* AVEC CES 2 INDICES EN PLUS ON EST DANS LE CAS 'RC'
                    BOOL.'RTD' = FAUX ;
                    BOOL.'RC' = VRAI ;
                    OPER1 = MOT SUPTAB.'OPERATEUR' ;
                SINON ;
* IL MANQUE AU MOINS UN DES DEUX INDICES
                    SI (LCHTRAN OU LOPERA) ;
* S'IL Y EN A UN DES DEUX ALORS IL MANQUE UNE INFO
                        MESS 'ERREUR : LE NOM DE L''OPERATEUR ET LE CHPOINT QUI' ;
                        MESS '         TRANSFORME LE COUDE EN TUYAUTERIE DROITE'
                        MESS '         SONT TOUS DEUX OBLIGATOIRES.' ;
                        QUIT CH_THETA ;
                    SINON ;
* AUCUN DES DEUX INDICES N'EST DONNE DONC ON EST DANS LE CAS 'RTD'
                        BOOL.'RTD' = VRAI ;
                        BOOL.'RC' = FAUX ;
                    FINSI ;
                FINSI ;
            SINON ;
* IL MANQUE DONC AU MOINS 2 POINTS
                SI (LPOINT1 OU LPOINT2) ;
* ON NE PEUT RIEN FAIRE AVEC UN SEUL DES DEUX POINTS
                    MESS 'ERREUR : ON VEUT POINT_1 ET POINT_2 POUR CONSTITUER' ;
                    MESS '         L''AXE PERPENDICULAIRE A LA SECTION FISSUREE.' ;
                    QUIT CH_THETA ;
                SINON ;
* IL N'Y A AUCUN DES POINTS
                    BOOL.'TTD' = FAUX ;
                    BOOL.'RTD' = FAUX ;
                    BOOL.'RC' = FAUX ;
                FINSI ;
            FINSI ;
        FINSI ;
* BOOLEEN POUR ROTATION (SINON C'EST FORCEMENT UNE TRANSLATION)
        BOOL.'ROTATION' = BOOL.'RTD' OU BOOL.'RC' ;
    SINON ;
* PAS EN 3D DONC AUCUN DES INDICES NE DOIT ETRE RENSEIGNE
        SI (LCHTRAN OU LOPERA OU LPOINT1 OU LPOINT2 OU LPOINT3) ;
            MESS 'ERREUR : UN DES INDICES RENSEIGNES NECESSITE' ;
            MESS '         D''ETRE EN DIMENSION 3.' ;
            QUIT CH_THETA ;
        SINON ;
* AUCUN DES INDICES N'A ETE RENSEIGNE DONC ON EST DANS AUCUN DES CAS
            BOOL.'TTD' = FAUX ;
            BOOL.'RTD' = FAUX ;
            BOOL.'RC' = FAUX ;
        FINSI ;
    FINSI ;
 
* CAS 2D : VERIFICATIONS EN CAS DE FISSURE CIRCULAIRE
    SI (EGA GDIME 2) ;
* BOOLEEN POUR ROTATION (SINON C'EST FORCEMENT UNE TRANSLATION)
        BOOL.'ROTATION' = EXIS SUPTAB 'POINT_CENTRE' ;
        SI BOOL.'ROTATION' ;
            PCENTRE = SUPTAB.'POINT_CENTRE' ;
        FINSI ;
    FINSI ;
 
FINSI ;
 
 
* II - EXTRACTION DES MAILLAGES NECESSAIRES
* -----------------------------------------
 
* CREATION DU MAILLAGE GLOBAL A BOUGER : MBOUGER
MBOUGER = FRON1 ;
REPE IBOUG COUCHE ;
    MBOUGER = MAILLAGE ELEM 'APPUYE' 'LARGEMENT' MBOUGER ;
FIN IBOUG ;
* CREATION DU SUPPORT GLOBAL DU CHAMP THETA : MAIL
MAIL = MAILLAGE ELEM 'APPUYE' 'LARGEMENT' MBOUGER ;
 
* EN 3D MASSIF ON DECOUPE LE MAILLAGE EN TRANCHES
SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
* ON ORDONNE LE FRONT DE FISSURE
    FRON1 = ORDO FRON1 ;
    PINIT = FRON1 'POIN' 'INIT' ;
    PFINA = FRON1 'POIN' 'FINA' ;
    FDEBOUCH = NEG (NOEU PINIT) (NOEU PFINA) ;
* DETERMINATION DES NOEUDS DU FRONT DANS L'ORDRE DE PARCOURT
    TPFISS = TABL ;
    REPE IELEM (NBEL FRON1) ;
        ELEM1 = FRON1 ELEM &IELEM ;
        PENLE = MANU 'POI1' (ELEM1 POIN 'FINA') ;
        PELEM1 = CHAN 'POI1' ELEM1 ;
        PAJOU = PELEM1 DIFF PENLE ;
        REPE IAJOU (NBNO PAJOU) ;
            TPFISS.((DIME TPFISS) + 1) = PAJOU 'POIN' &IAJOU ;
        FIN IAJOU ;
    FIN IELEM ;
    TPFISS.((DIME TPFISS) + 1) = PFINA ;
* DECOUPAGE EN TRANCHES DE MAIL ET MBOUGER
    TMAIL = COPI TPFISS ;
    N1 = (NBNO (FRON1 ELEM 1)) - 1 ;
    REPE ICOUCH (COUCHE + 1) ;
        REPE IELEM (NBEL FRON1) ;
            I1 = (N1*(&IELEM - 1)) + 1 ;
            I2 = I1 + N1 ;
            SURF1 = TMAIL.I1 ;
            SURF2 = TMAIL.I2 ;
            VOL1 = MAILLAGE ELEM 'APPUYE' 'LARGEMENT' SURF1 ;
            VOL2 = MAILLAGE ELEM 'APPUYE' 'LARGEMENT' SURF2 ;
            VOL3 = VOL1 INTE VOL2 ;
            DVOL3 = ENVE VOL3 ;
            SURF1 = DVOL3 ELEM 'APPUYE' 'LARGEMENT' SURF1 ;
            SURF2 = DVOL3 ELEM 'APPUYE' 'LARGEMENT' SURF2 ;
            SURF12 = SURF1 INTE SURF2 ;
            SURF1 = SURF1 DIFF SURF12 ;
            SURF2 = SURF2 DIFF SURF12 ;
            TMAIL.I1 = SURF1 ;
            SI (EGA N1 2) ;
                MIL1 = (CHAN 'POI1' VOL3) DIFF (CHAN 'POI1' (SURF1 ET SURF2)) ;
                TMAIL.(I1 + 1) = MIL1 ;
            FINSI ;
        FIN IELEM ;
        TMAIL.(DIME TMAIL) = SURF2 ;
        SI (EGA &ICOUCH COUCHE) ;
            TMBOUGER = COPI TMAIL ;
        FINSI ;
    FIN ICOUCH ;
* SI LE FRONT EST FERME ON ENLEVE LES DERNIERS INDICES DES TABLEAUX
* CAR ILS SONT IDENTIQUES AUX PREMIERS
    SI (NON FDEBOUCH) ;
        OTER TPFISS (DIME TPFISS) ;
        OTER TMAIL (DIME TMAIL) ;
        OTER TMBOUGER (DIME TMBOUGER) ;
    FINSI ;
* ON AJOUTE LES MAILLAGES GLOBAUX
    NPFISS = DIME TPFISS ;
    TPFISS.(NPFISS + 1) = FRON1 ;
    TMAIL.(NPFISS + 1) = MAIL ;
    TMBOUGER.(NPFISS + 1) = MBOUGER ;
FINSI ;
 
 
* III - CALCUL DU CHAMP THETA/PI
* ------------------------------
 
SI CALCUL ;
 
* III.1 - DIRECTION DE PROPAGATION
* ********************************
 
* CAS 2D OU 3D COQUE :
* ********************
    SI ((EGA GDIME 2) OU BOOL.'COQ') ;
* ON DETERMINE LA DIRECTION DE PROPAGATION
        FISS1 = CRACK ELEM 'APPUYE' 'LARGEMENT' FRON1 ;
        NELEM = NBEL FISS1 ;
* ON FAIT LA MOYENNE SUR LES DEUX POINTS QUI NE SONT PAS FRON1
* POUR LE CAS OU LES DEUX LEVRES SONT MODELISEES
        VECTEUR = VNUL ;
        REPE IELEM NELEM ;
            SEG1 = FISS1 ELEM &IELEM ;
            PINIFIN = ('POIN' SEG1 'INIT') ET ('POIN' SEG1 'FINA') ;
            P1 = 'POIN' ('DIFF' PINIFIN ('MANU' 'POI1' FRON1)) 1 ;
            VEC1 = FRON1 MOIN P1 ;
            VECTEUR = VECTEUR PLUS VEC1 ;
        FIN IELEM ;
        VECTEUR = VECTEUR / NELEM ;
    FINSI ;
 
* CAS 3D MASSIF :
* ***************
    SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
* DETERMINATION DU VECTEUR NORMAL AU PLAN DE FISSURE
        SEG1 = (CHAN 'LIGNE' CRACK) ELEM 'APPUYE' 'LARGEMENT' PINIT ;
        SEG1 = SEG1 DIFF (SEG1 INTE FRON1) ;
        PMOY = PINIT MOIN PINIT ;
        REPE IELEM (NBEL SEG1) ;
            ELEM1 = SEG1 ELEM &IELEM ;
            PINIFIN = ('POIN' ELEM1 'INIT') ET ('POIN' ELEM1 'FINA') ;
            P1 = 'POIN' ('DIFF' PINIFIN ('MANU' 'POI1' PINIT)) 1 ;
            PMOY = PMOY PLUS P1 ;
        FIN IELEM ;
        PMOY = PMOY / (NBEL SEG1) ;
        VEC1 = PINIT MOIN PMOY ;
        VEC2 = TPFISS.(2) MOIN TPFISS.(1) ;
        VNORM = VEC1 PVEC VEC2 ;
        VNORM = VNORM / (NORM VNORM) ;
 
* PASSAGE DU TUYAU EN PLAQUE
        SI BOOL.'TTD' ;
            DEPL MAILLAGE 'COOR' 'CYLI' PAXEZ1 PAXEZ2 PAXEZ3 ;
        FINSI ;
 
* DIRECTION D'AVANCEE DE FISSURE EN CHAQUE POINT DU FRONT
        TVECTEUR = TABL ;
        LN1 = LECT NPFISS 1 PAS 1 (NPFISS - 1) ;
        LN2 = LECT 2 PAS 1 NPFISS 1 ;
        SI FDEBOUCH ;
* SI LE FRONT EST DEBOUCHANT ON ENLEVE LE PREMIER ET LE DERNIER NOEUD...
            LN1 = ENLE LN1 (LECT 1 NPFISS) ;
            LN2 = ENLE LN2 (LECT 1 NPFISS) ;
            I0 = 1 ;
* ...ET ON LES TRAITE ICI
            LENT1 = LECT 1 NPFISS ;
            REPE IENT 2 ;
* ON BOUCLE SUR LE PREMIER ET LE DERNIER NOEUD
                INOEU = EXTR LENT1 &IENT ;
                P1 = TPFISS.INOEU ;
                SEG1 = (CHAN 'LIGNE' CRACK) ELEM 'APPUYE' 'LARGEMENT' P1 ;
                SEG1 = SEG1 DIFF (SEG1 INTE FRON1) ;
                PMOY = P1 MOIN P1 ;
                REPE IELEM (NBEL SEG1) ;
* ON BOUCLE SUR LE OU LES SEGMENTS APPUYES SUR P1 (1 OU 2 LEVRES DONNEES)
                    ELEM1 = SEG1 ELEM &IELEM ;
                    PINIFIN = (ELEM1 POIN 'INIT') ET (ELEM1 POIN 'FINA') ;
                    P2 = (DIFF (CHAN 'POI1' ELEM1) (MANU 'POI1' P1)) POIN 'PROC' P1 ;
                    PMOY = PMOY PLUS P2 ;
                FIN IELEM ;
                PMOY = PMOY / (NBEL SEG1) ;
                TVECTEUR.INOEU = P1 MOIN PMOY ;
            FIN IENT ;
        SINON ;
            I0 = 0 ;
        FINSI ;
        REPE IPFISS (DIME LN1) ;
* POINTS P1 ET P2 DE PART ET D'AUTRE DU POINT &IPFISS
            P1 = TPFISS.(EXTR LN1 &IPFISS) ;
            P2 = TPFISS.(EXTR LN2 &IPFISS) ;
* ON OBTIENT LE VECTEUR TANGENT AU FRONT
            VTANG = (P2 MOIN P1)/2. ;
* LE PRODUIT VECTORIEL AVEC VNORM DONNE LA DIRECTION DE PROPAGATION
            TVECTEUR.(&IPFISS + I0) = VTANG PVEC VNORM ;
        FIN IPFISS ;
 
* ON AJOUTE LE CHAMP GLOBAL DE DIRECTION DE PROPAGATION
        LNORM = PROG ;
* ON BOUCLE SUR LES NOEUDS POUR DETERMINER LE MIN DES NORMES DES VECTEURS
        REPE IPFISS NPFISS ;
            LNORM = LNORM ET (PROG (NORM TVECTEUR.&IPFISS)) ;
        FIN IPFISS ;
        MINNORM = MINI LNORM ;
* PUIS ON REBOUCLE POUR CREER LE CHPO DE DIRECTION
        GDIR = 'VIDE' 'CHPOINT'/'DIFFUS' ;
        REPE IPFISS NPFISS ;
            N1 = MINNORM / (EXTR LNORM &IPFISS) ;
            X Y Z = COOR (TVECTEUR.&IPFISS * N1) ;
            CHPO1 = MANU 'CHPO' TMAIL.&IPFISS MUI (PROG X Y Z) 'NATURE' 'DIFFUS' ;
            GDIR = GDIR + CHPO1 ;
        FIN IPFISS ;
        TVECTEUR.(NPFISS + 1) = GDIR ;
 
* ON REPASSE LA PLAQUE EN TUYAU
        SI BOOL.'TTD' ;
            DEPL MAILLAGE 'COOR' 'CART' ;
        FINSI ;
 
        VECTEUR = GDIR ;
    FINSI ;
 
 
* III.2 - CHAMP THETA GLOBAL
* **************************
 
* CONFIGURATION INITIALE
    CONF0 = FORM ;
 
* ON COMMENCE PAR DEPLACER LES NOEUDS DE MBOUGER
    SI BOOL.'ROTATION' ;
* CAS DE LA ROTATION
        ANG1 = .01 ;
        SI (EGA GDIME 2) ;
            DEPL 'TOUR' MBOUGER ANG1 PCENTRE ;
        SINON ;
            SI BOOL.'RC' ;
                DEPL OPER1 MAILLAGE SUPTAB.'CHPOINT_TRANSFORMATION' ;
            FINSI ;
            DEPL 'TOUR' MBOUGER ANG1 POINT_1 POINT_2 ;
            SI BOOL.'RC' ;
                DEPL OPER1 MAILLAGE (-1.*(SUPTAB.'CHPOINT_TRANSFORMATION')) ;
            FINSI ;
        FINSI ;
    SINON ;
* CAS DE LA TRANSLATION
        SI BOOL.'TTD' ;
            DEPL MAILLAGE 'COOR' 'CYLI' PAXEZ1 PAXEZ2 PAXEZ3 ;
        FINSI ;
        DEPL 'PLUS' MBOUGER VECTEUR ;
        SI BOOL.'TTD' ;
            DEPL MAILLAGE 'COOR' 'CART' ;
        FINSI ;
    FINSI ;
* ON CREE MAIL2
    MAIL2 = MAIL PLUS VNUL ;
* PUIS ON INVERSE LA TRANSFORMATION
    SI BOOL.'ROTATION' ;
* CAS DE LA ROTATION
        SI (EGA GDIME 2) ;
            DEPL 'TOUR' MBOUGER (0. - ANG1) PCENTRE ;
        SINON ;
            SI BOOL.'RC' ;
                DEPL OPER1 MAILLAGE SUPTAB.'CHPOINT_TRANSFORMATION' ;
            FINSI ;
            DEPL 'TOUR' MBOUGER (0. - ANG1) POINT_1 POINT_2 ;
            SI BOOL.'RC' ;
                DEPL OPER1 MAILLAGE (-1.*(SUPTAB.'CHPOINT_TRANSFORMATION')) ;
            FINSI ;
        FINSI ;
    SINON ;
* CAS DE LA TRANSLATION
        SI BOOL.'TTD' ;
            DEPL MAILLAGE 'COOR' 'CYLI' PAXEZ1 PAXEZ2 PAXEZ3 ;
        FINSI ;
        DEPL 'MOIN' MBOUGER VECTEUR ;
        SI BOOL.'TTD' ;
            DEPL MAILLAGE 'COOR' 'CART' ;
        FINSI ;
    FINSI ;
 
* CHAMP THETA GLOBAL
    THETA = MAIL2 MOIN MAIL ;
 
* ON REND THETA COMPATIBLE AVEC LES RELATIONS DE CONFORMITE DU MODELE
    THETA = CFND THETA OBJUTI.'MOD_MEC' ;
 
* ON REPREND LA CONFIGURATION INITIALE DANS LE CAS OU ELLE AURAIT ETE
* MODIFIEE PAR DEPL
    FORM CONF0 ;
 
* STOCKAGE DANS SUPTAB
    SUPTAB.(CHAI 'CHAMP_' RESULT) = THETA ;
 
FINSI ;
 
 
* IV - CREATION ET REMPLISSAGE DE LA TABLE TTHETA
* -----------------------------------------------
 
* FONCTIONS D'INTERPOLATION
TINTER = TABL ;
SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
    REPE IPFISS NPFISS ;
        SI (DANS TPFISS.&IPFISS NOAV) ;
            FINTER = MANU 'CHPO' TMBOUGER.&IPFISS 1 'SCAL' 1. 'NATURE' 'DISCRET' ;
            TINTER.&IPFISS = FINTER ;
        FINSI ;
    FIN IPFISS ;
SINON ;
    TINTER.(1) = MANU 'CHPO' MBOUGER 1 'SCAL' 1. 'NATURE' 'DISCRET' ;
FINSI ;
* TABLE TTHETA
TTHETA = TABL ;
TIND = INDE TINTER ;
REPE IIND (DIME TIND) ;
    FINTER = TINTER.(TIND.&IIND) ;
    THETI = FINTER * THETA ;
    FFRON = REDU FINTER FRON1 ;
    TTHETA.FFRON = THETI ;
FIN IIND ;
SI ((EGA GDIME 3) ET (NON BOOL.'COQ')) ;
    TTHETA.'GLOBAL' = THETA ;
FINSI ;
 
 
* V - NORMALISATION DU CHAMP THETA
* --------------------------------
 
* CE QU'ON VEUT C'EST QUE LA SURFACE DE FISSURE CREEE PAR LE MOUVEMENT INFINITESIMAL
* EPS1*THETA SOIT EGALE A 2.*EPS1 LORSQUE EPS1 << 1.
* NB : ON VEUT 2.*EPS1 CAR LA FISSURE A FORCEMENT DEUX LEVRES, MEME SI UNE SEULE
* EST MODELISEE !
 
* PARTIE DE LA FISSURE QUI AVANCE
CRACK1 = CRACK ELEM 'APPUY' 'LARGEMENT' MBOUGER ;
* MODELE THERMIQUE ISOTROPE POUR INTEGRER SUR LES LEVRES DE FISSURE
* AVANTAGE : FONCTIONNE DANS TOUS LES CAS
* (2D, 3D ET PAS BESOIN DE MULTIPLIER PAR 2*PI*R EN AXISYMETRIQUE)
MODTH = MODE CRACK1 'THERMIQUE' ;
CHML1 = MANU 'CHML' MODTH 'SCAL' 1. ;
* ON CALCULE L'AIRE INITIALE
A0 = INTG CHML1 MODTH ;
* ON DETERMINE LA DIMENSION CARACTERISTIQUE LMIN DU MAILLAGE DU FRONT
LIG1 = CHAN 'LIGNE' CRACK1 ;
MES1 = MESU LIG1 'DENS' ;
LMIN = MINI MES1 ;
* PETIT FLOTTANT POUR QUE LE MOUVEMENT SOIT INFINITESIMAL
EPS1 = 1.E-4 ;
* BOUCLE SUR LES CHAMPS
TIND = INDE TTHETA ;
REPE ICHAM (DIME TIND) ;
    THETI = TTHETA.(TIND.&ICHAM) ;
* ON CREE UN CHAMP THETI DONT LA NORME EST PROCHE DE LA DIMENSION DES ELEMENTS
    NTHETI = (PSCA THETI THETI MUI MUI)**0.5 ;
    THETI = THETI * LMIN / (MAXI NTHETI) ;
* ON DEPLACE LES NOEUDS, ON CALCULE L'AIRE, PUIS ON INVERSE LA TRANSFORMATION
    DEPL MBOUGER 'PLUS' (EPS1*THETI) ;
    A1 = INTG CHML1 MODTH ;
    DEPL MBOUGER 'MOIN' (EPS1*THETI) ;
* DELTA_A EST LA SURFACE DE FISSURE CREEE PAR LEVRE
    DELTA_A = (A1 - A0) / EPS1 ;
    SI BOOL.'COQ' ;
* POUR LES COQUES IL FAUT MULTIPLIER PAR L'EPAISSEUR
        DELTA_A = DELTA_A * SUPTAB.'EPAISSEUR' ;
    FINSI ;
    THETI = THETI * 2. / DELTA_A ;
* ON REND LES THETI COMPATIBLES AVEC LES RELATIONS DE CONFORMITE DU MODELE
    THETI = CFND THETI OBJUTI.'MOD_MEC' ;
    TTHETA.(TIND.&ICHAM) = THETI ;  
FIN ICHAM ;
* STOCKAGE DANS SUPTAB
SUPTAB.(CHAI 'TAB_' RESULT) = TTHETA ;
 
 
* =============================================================================
*              PARTIE 2 : EXTRACTION DE LA DIRECTION DE PROPAGATION
*              ----------------------------------------------------
 
SI (NON (EXIS OBJUTI 'DIRECTION1')) ;
* ON EXTRAIT LA DIRECTION DE PROPAGATION ET LES NORMALES DU CHAMP THETA
    CHTHETA = SUPTAB.'CHAMP_THETA' ;
    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 ;
* ON STOCKE LES DIRECTIONS DANS OBJUTI
    OBJUTI.'DIRECTION1' = DIR1 ;
    SI (NON BOOL.'COQ') ;
        OBJUTI.'DIRECTION2' = DIR2 ;
        SI (EGA GDIME 3) ;
            OBJUTI.'DIRECTION3' = DIR3 ;
        FINSI ;
    FINSI ;
FINSI ;
 
 
* =============================================================================
*              PARTIE 3 : APPEL RECURSIF POUR LE CALCUL DU CHAMP PI
*              ----------------------------------------------------
 
* SI L'OBJECTIF EST 'DJ/DA' ET QU'ON A PAS ENCORE DETERMINE LE CHAMP PI, ALORS
* ON RELANCE CH_THETA SUR UNE COPIE DE SUPTAB AVEC LES MODIFICATIONS
* NECESSAIRES, PUIS ON EXTRAIT LES INDICES 'CHAMP_PI' ET 'TAB_PI' DU RESULTAT
SI (BOOL.'DJ/DA' ET (NON (EXIS SUPTAB 'TAB_PI'))) ;
    SUPTAB2 = COPI SUPTAB ;
    SI (NON (EXIS SUPTAB 'FRONT_FISSURE_2')) ;
        SUPTAB2.'COUCHE' = (SUPTAB.'COUCHE') - 1 ;
    SINON ;
        SUPTAB2.'FRONT_FISSURE' = SUPTAB.'FRONT_FISSURE_2' ;
        SUPTAB2.'FISSURE' = SUPTAB.'FISSURE_2' ;
    FINSI ;
    CH_THETA SUPTAB2 OBJUTI BOOL ;
    SUPTAB.'CHAMP_PI' SUPTAB.'TAB_PI' = SUPTAB2.'CHAMP_PI' SUPTAB2.'TAB_PI' ;
FINSI ;
 
FINP ;