$$$$ CH_THETA * CH_THETA PROCEDUR JB251061 21/06/14 21:15:01 11034 * ============================================================================= * 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 * ----------------------------- * VERIFICATION DE LA VALEUR DE 'ELEM' GELEM = VALE 'ELEM' ; SI (EGA GELEM ' ') ; MESS 'ERREUR : TYPE D''ELEMENTS NON DECLARE. UTILISEZ' ; MESS ' L OPERATEUR OPTI POUR LE DECLARER' ; QUIT CH_THETA ; FINSI ; * 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 ;