Télécharger ctod.procedur

Retour à la liste

* CTOD      PROCEDUR  JC220346  12/09/12    21:15:06     7501           
DEBPROC CTOD SUPTAB*TABLE U*CHPOINT ;
*************************************************
*   PROCEDURE POUR LA DETERMINATION DU CTOD     *
*     PAR LA METHODE DE LA DROITE A 45 DEGRES   *
***************************************************************
*SUPTAB.'MAILLAGE' : MAILLAGE ENTIER (UTILE UNIQUEMENT EN 3D)          *
*                                                                      *
*SUPTAB.'LIFIS1' :    OBJET  DE TYPE MAILLAGE REPRESENTANT LA LIGNE    *
*                     DE FISSURE  EN 2D                                *
*                  CETTE LIGNE DOIT CONTENIR AU MOINS 6 ELEMENTS       *
*                                                                      *
*                                                                      *
*                                                                      *
* SUPTAB.'FRTFISS' : LIGNE DE FRONT DE FISSURE EN 3 D DE TYPE MAILLAGE *
*                    POINTE DE FISSURE EN 2D DE TYPE POINT             *
*                                                                      *
*SUPTAB.'PSF1'  : POINTS DE LA SURFACE DE FISSURE                      *
*                 N'APPARTENANT PAS AU FRONT DE FISSURE EN 3D          *
*                                                                      *
* U : DEPLACEMENT RESULTANT DE NONLIN  AU TEMPS SOUHAITE               *
*                                                                      *
************************************************************************
*                         SORTIE                                       *
* SUPTAB.'CTOD' :*TABLE DE REELS CONTENANT LES VALEURS DE CTOD OBTENUES*
*                 A CHAQUE NOEUD P  DU FRONT DE FISSURE EN 3D          *
*                 LES INDICES DE CETTE TABLE SONT DE TYPE POINT        *
*                 EX : SUPTAB.'CTOD'.P : CTOD AU NOEUD DU FRONT DE     *
*                      COORDONNEES EGALES A CELLES DU POINT P          *
*                *REEL  : VALEUR DU CTOD OBTENUE EN 2D                 *
************************************************************************
 
************************************************************************
*****************  QUELQUES INITIALISATIONS   **************************
************************************************************************
 
&DIM = 'VALEUR' DIME;
&ELEM = 'VALEUR' ELEM;
&IMP = 'VALEUR' IMPI ;
IELEM2 = (EGA &ELEM 'TRI3') 'OU' (EGA &ELEM 'QUA4');
IELEM3 = (EGA &ELEM 'CUB8') 'OU' (EGA &ELEM 'PRI6');
IELEMLIN = IELEM2 'OU' IELEM3;
 
SI (EGA &DIM 3);
**------------cas où l'on est en dimension 3----------**
  FRTFISS = SUPTAB.'FRTFISS';
  PSF = SUPTAB.'PSF1';
  MAILLAGE = SUPTAB.'MAILLAGE';
 
SINON;
**-----------cas où l'on est en dimension 2-----------**
  LIFIS1 = SUPTAB.'LIFIS1';
  PF = SUPTAB.'FRTFISS';
 
FINSI;
 
 
***************************************************************
**************    CALCULS EN DIMENSION 3     ******************
*******RECUPERATION DES LIGNES PERPENDICULAIRES AU FRONT*******
*******DE FISSURE SUR LESQUELLES SERONT EFFECTUES LES CALCULS**
***************************************************************
*&&&&&&&&&&&&&&&&*
SI (EGA &DIM 3);
*&&&&&&&&&&&&&&&&*
*------determination de cas de fissure debouchante ou non-----*
 
TMAIL = TABLE;
TM = TABLE;
TRANCHE = TABLE;
P = (NBEL FRTFISS) + 1;
*-----recuperation des points extremites du front de fissure----*
 
FRTFISS = ORDO FRTFISS;
PINIT = FRTFISS POIN 'INIT';
PFIN = FRTFISS POIN 'FINAL';
 
*-----determination du volume de travail MAILVOL----------------*
MAILVOL = FRTFISS;
REPETER BVOL 7;
  MAILVOL = MAILLAGE ELEM APPU LARG MAILVOL;
FIN BVOL;
 
*--récupération de la surface initiale de MAILVOL : SURINIT-----*
SURINIT = PINIT;
REPETER BSURINIT 7;
  VCUB = MAILLAGE ELEM APPU LARG SURINIT;
  SCUB = ENVE VCUB;
  SURINIT = SCUB ELEM APPU LARG SURINIT;
FIN BSURINIT;
POINTFIS = SURINIT POIN 'PLAN' PINIT PFIN PSF 0.01;
ELEMSFIS = SURINIT ELEM APPU STRI POINTFIS;
SURINIT = SURINIT DIFF ELEMSFIS;
SURINIT1 = SURINIT;
SURINIT = PINIT;
REPETER BSURI 7;
  SURINIT = SURINIT1 ELEM APPU LARG SURINIT ;
FIN BSURI ;
*--récupération de la surface finale de MAILVOL : SURFIN-------*
SURFIN = PFIN;
REPETER BSURFIN 7;
  VCUB = MAILLAGE ELEM APPU LARG SURFIN;
  SCUB = ENVE VCUB;
  SURFIN = SCUB ELEM APPU LARG SURFIN;
FIN BSURFIN;
POINTFIS = SURFIN POIN 'PLAN' PINIT PFIN PSF 0.01;
ELEMSFIS = SURFIN ELEM APPU STRI POINTFIS;
SURFIN = SURFIN DIFF ELEMSFIS;
SURFIN1 = SURFIN;
SURFIN = PFIN ;
REPETER BSURF 7 ;
  SURFIN = SURFIN1 ELEM APPU LARG SURFIN;
FIN BSURF ;
*--remplissage de la table des plans orthogonaux à la fissure--*
*---------------------   TMAIL     ----------------------------*
TMAIL.1 = CHAN SURINIT POI1;
TM.1 = SURINIT;
TRANCHE.1 = MAILVOL ELEM APPU LARG SURINIT;
I = 0;  TRANCHET = TRANCHE.1;
SI ((NBEL FRTFISS) > 1);
REPETER BRECU ((NBEL FRTFISS ) - 1);
  I = I + 1;
**--récuperation des tranches--**
  TRANCHE.(I + 1) = (MAILVOL ELEM APPU LARG TRANCHET) DIFF TRANCHET;
  TRANCHET = TRANCHET ET TRANCHE.(I + 1);
  ENVEBI = DIFF (ENVE TRANCHE.(I + 1)) (ENVE TRANCHE.I);
  TMAIL.(I + 1) = DIFF ENVEBI
                  ((ENVE TRANCHE.(I + 1)) ET (ENVE TRANCHE.I));
  TM.(I + 1) = TMAIL.(I + 1);
  TMAIL.(I + 1) = TMAIL.(I + 1) CHAN POI1;
 
FIN BRECU;
FINSI;
TMAIL.P = CHAN SURFIN POI1;
TM.P = SURFIN ;
 
*-------récupération des lignes supports de calcul----------*
*------intersections entre les plans de TMAIL et la---------*
*---------------------surface de fissure--------------------*
 
**--récupération de la surface de fissure : SURFIS--**
 
ENVMAIL = ENVE MAILLAGE;
PLANFIS = ENVMAIL POINT 'PLAN' PINIT PFIN PSF 0.001;
PLANFIS = ENVMAIL ELEM APPU STRICT PLANFIS;
CO = CONT PLANFIS  ;
CO1 = (CO COMP PINIT PFIN);
COSURFIS = CO1 et FRTFISS ;
ELPSF = PLANFIS ELEM APPU LARG PSF;
SURFIS = PLANFIS INCLU COSURFIS;
SS = ELPSF DIFF SURFIS;
**--cas où on n'a pas pris la bonne partie du plan pour SURFIS--**
SI (EGA (NBEL SS) ((NBEL ELPSF) + (NBEL SURFIS)));
  SURFIS = PLANFIS DIFF SURFIS;
FINSI;
 
 
**--récupération des lignes et des points du front de fissure--**
TLIG = TABLE;TPF = TABLE;
I = 0;
CHSURFIS = SURFIS CHAN POI1;
CHFRTFIS = CHAN FRTFISS POI1;
REPETER BLIG P;
  I = I + 1;
**--récupération des lignes--**
 
  TOT = TMAIL.I ET CHSURFIS; DIFSYM = TMAIL.I DIFF CHSURFIS;
  TLIG.I = DIFF TOT DIFSYM;
  TLIG.I = TMAIL.I ELEM APPU STRI TLIG.I;
 
**--récupération des points du front de fissure--**
 
  TOT =  TLIG.I ET CHFRTFIS;
  DIFSYM =  TLIG.I DIFF CHFRTFIS;
  TPF.I =  DIFF TOT DIFSYM;
  TPF.I = TLIG.I ELEM APPU STRI TPF.I;
  TPF.I = TPF.I POIN 1;
  H = CONT TM.I;
  TLIG.I = H ELEM APPU STRI TLIG.I;
FIN BLIG;
 
 
 
*&&&&&&*
FINSI;
*&&&&&&*
 
***************************************************************
**************   DIMENSION 2 ET 3            ******************
***************************************************************
*&&&&&&&&&&&&&&&*
SI (EGA &DIM 2 );
*&&&&&&&&&&&&&&&*
  P = 1;
*&&&&&&&*
FINSI;
*&&&&&&&*
CTOD = TABLE;
  SI (EGA &DIM 3);
  SUPTAB.'CTOD' = TABLE;
  FINSI;
J = 0;
REPETER BKTOTALE P;
  J = J + 1;
  SI (EGA &DIM 3);
    PF = TPF.J;
    LIGCTOD = TLIG.J;
    MESS 'LIGNE ' J ' DU FRONT DE FISSURE';
  SINON;
    LIGCTOD = LIFIS1;
  FINSI;
 
 
  LIGCTOD = ORDO LIGCTOD;
  SI (NEG (POIN 1 LIGCTOD) PF);
    LIGCTOD = INVE (LIGCTOD);
  FINSI;
   P0 = LIGCTOD POIN 2;
   N = NBEL LIGCTOD;
   PN = LIGCTOD POIN (N + 1);
   TYPMOD = 'VALEUR' MODE;
 
*-----PASSAGE DANS LE REPERE LOCAL DE FISSURE---------------*
 
* TRANSLATION DES CHPS DE DEPL : NOUVELLE ORIGINE PF
**--récupération des composantes du déplacement--**
    SI ((EGA TYPMOD 'PLANDEFO') OU (EGA TYPMOD 'PLANCONT')
    OU (EGA TYPMOD 'TRID'));
       CHVX = EXCO U 'UX';
       CHVY = EXCO U 'UY';
    FINSI;
    SI (EGA TYPMOD 'AXIS');
       CHVX = EXCO U 'UR';
       CHVY = EXCO U 'UZ';
    FINSI;
       VXPF= EXTR CHVX 'SCAL' PF;
       VYPF= EXTR CHVY 'SCAL' PF;
       PMAIL = EXTR U 'MAIL';
       CHVXPF=MANU CHPO PMAIL 1 'SCAL' VXPF;
       CHVYPF=MANU CHPO PMAIL 1 'SCAL' VYPF;
       CHVX=CHVX - CHVXPF;
       CHVY=CHVY - CHVYPF;
    SI (EGA TYPMOD 'TRID');
       CHVZ = EXCO U 'UZ';
       VZPF= EXTR CHVZ 'SCAL' PF;
       CHVZPF=MANU CHPO PMAIL 1 'SCAL' VZPF;
       CHVZ=CHVZ - CHVZPF;
    FINSI;
 
* ROTATION DES CHPS DE DEPL : DS REPERE DE LA FISSURE
**----cas du 2 D----**
  SI (EGA &DIM 2);
    VECU = P0 MOIN PN;
    XU = VECU / (NORM VECU);
    YV = XU PVECT;
    X1 = COOR 1 XU; Y1 = COOR 2 XU;
    X2 = COOR 1 YV; Y2 = COOR 2 YV;
       CHU = (CHVX * X1) + (CHVY * Y1);
       CHV = (CHVX * X2) + (CHVY * Y2);
**----cas du 3 D----**
  SINON;
**--récupération du repère local :XU YV ZW--**
    VECU = P0 MOIN PN;
    XU = VECU / (NORM VECU);
    SI ((NBEL FRTFISS) > 1);
      FRTFI = FRTFISS DIFF (FRTFISS ELEM APPU LARG PF);
      PPRO = FRTFI POIN PROC PF;
    SINON;
      FRTFI = FRTFISS CHAN POI1;
      FRTFI = FRTFI DIFF (FRTFI ELEM APPU LARG PF);
      PPRO = FRTFI POIN PROC PF;
    FINSI;
    VECV = PPRO MOIN PF;
    YV = VECV / (NORM VECV);
    ZW = XU PVEC YV;
    ZW = ZW / (NORM ZW);
**--calcul de la matrice de passage --**
    X1 = COOR 1 XU; Y1 = COOR 2 XU; Z1 = COOR 3 XU;
    X2 = COOR 1 YV; Y2 = COOR 2 YV; Z2 = COOR 3 YV;
    X3 = COOR 1 ZW; Y3 = COOR 2 ZW; Z3 = COOR 3 ZW;
**--calcul des déplacements dans le repère local--**
**--mode 1--**
    CHV = (X3 * CHVX) + (Y3 * CHVY) + (Z3 * CHVZ);
**--mode 2--**
    CHU = (X1 * CHVX) + (Y1 * CHVY) + (Z1 * CHVZ);
FINSI;
 
**************************************************************
*                      CALCUL DU CTOD                        *
**************************************************************
 
**-- détermination de l'element d'intersection avec D45 par itération--**
**--( si elle existe  )--**
 
  ICTOD = 0;
  TESTE = 6;
  BCOUP = 'FAUX';
  REPETER BCTOD TESTE;
    ICTOD = ICTOD + 1;
    P1 = LIGCTOD POIN ICTOD;
    P2 = LIGCTOD POIN (ICTOD + 1);
    VECP1 = P1 MOIN PF;
    R1 = NORM (VECP1);
    VECP2 = P2 MOIN PF;
    R2 = NORM (VECP2);
    V1 = EXTR (REDU CHV P1) 'SCAL' P1;
    V1 = ABS (V1);
    SI (EGA P1 PF); V1 = 0.;FINSI;
    V2 = EXTR (REDU CHV P2) 'SCAL' P2;
    V2 = ABS (V2);
    SI ((V1 >EG R1) ET (V2 <EG R2));
      ELCTOD = LIGCTOD COMP P1 P2;
      BCOUP = 'VRAI';
      QUIT BCTOD;
    FINSI;
  FIN BCTOD;
  SI (EGA &IMP 1);
    mess 'INTERSECTION SUR L ELEMENT N°' ICTOD;
    mess 'NOEUD 1 SOMMET : R1 = ' R1 ' V1 = ' V1;
    mess 'NOEUD 2 SOMMET : R2 = ' R2 ' V2 = ' V2;
  FINSI;
*----------CAS OU L'INTERSECTION EXISTE : CALCUL PLASTIQUE------*
*---------CALCUL DU CTOD AVEC L'INTERSECTION DE LA DROITE A 45--*
  SI (EGA BCOUP 'VRAI');
**-cas d'éléments linéaires--**
    SI (IELEMLIN);
      ETA = (V1 + V2 - R1 - R2) / (V1 - V2 + R2 - R1);
      N1 = (1 - ETA) / 2;
      N2 = (1 + ETA) / 2;
      V = (N1 * V1) + (N2 * V2) ;
      CTOD.PF = 2 * V;
      SI (((V > R1) ET (V < R2) ET
             (V1 < V) ET (V < V2)));
          MESS 'LE CTOD A D45° VAUT :'CTOD.PF;
      SINON;
          CTOD.PF = 0;
          MESS 'PAS D INTERSECTION AVEC LA DROITE A 45°';
      FINSI;
    SINON;
      ELPO = CHAN ELCTOD POI1;
      ELINT = ELPO DIFF (ELPO ELEM APPU LARG P1);
      PM = ELINT POIN PROC P1;
      VECPM = PM MOIN PF;
      RM = NORM (VECPM);
      VM = EXTR (REDU CHV PM) 'SCAL' PM;
      VM = ABS (VM);
      SI (EGA &IMP 1);
        mess 'NOEUD MILIEU : RM = ' RM ' VM = ' VM;
      FINSI;
      A = ((2 * VM) - V1 - V2);
      B = (R2 - R1 + V1 - V2);
      C = 2 * (RM - VM);
      DELTA = (B**2) - (4 * A * C);
      SI (DELTA >EG 0);
         ETA1 = (((-1) * B) - (DELTA**0.5)) / (2 * A);
         ETA2 = (((-1) * B) + (DELTA**0.5)) / (2 * A);
         N1A = ETA1 * (ETA1 - 1) / 2;
         NMA = 1 - (ETA1**2);
         N2A = ETA1 * (ETA1 + 1) / 2;
         VA = (N1A * V1) + (NMA * VM) + (N2A * V2);
         N1B =  ETA2 * (ETA2 - 1) / 2;
         NMB =  1 - (ETA2**2);
         N2B =  ETA2 * (ETA2 + 1) / 2;
         VB =  (N1B * V1) + (NMB * VM) + (N2B * V2);
         SI ((ABS (ETA1) &lt;EG 1) OU (ABS (ETA2) &lt;EG 1));
           SI (EGA ICTOD 1);
             SI ((ABS (ETA1) &lt;EG 1) ET (ABS (ETA2) &lt;EG 1));
               PCTOD = PROG VA VB;
               CTOD.PF  = 2 * (MAXI PCTOD);
               MESS 'LE CTOD A D45° VAUT :'CTOD.PF;
             SINON;
               CTOD.PF = 0;
               MESS 'PAS D INTERSECTION AVEC LA DROITE A 45°';
             FINSI;
           SINON;
             SI (((VA > R1) ET (VA < RM) ET
                (V1 < VA) ET (VA < VM))
             OU ((VA > RM) ET (VA < R2) ET
                (VM < VA) ET (VA < V2)));
               CTOD.PF = 2 * VA;
               MESS 'LE CTOD A D45° VAUT :'CTOD.PF;
             SINON;
               SI (((VB > R1) ET (VB < RM) ET
                  (V1 < VB) ET (VB < VM))
               OU  ((VB > RM) ET (VB < R2) ET
                   (VM < VB) ET (VB < V2)));
                 CTOD.PF = 2 * VB;
                 MESS 'LE CTOD A D45° VAUT :'CTOD.PF;
               SINON;
                 CTOD.PF = 0;
                 MESS 'PAS DE SOLUTION SATISFAISANTE';
               FINSI;
             FINSI;
           FINSI;
 
         SINON;
           CTOD.PF = 0;
           SI (EGA &IMP 1);
           MESS ' PAS DE ETA ENTRE -1 ET 1';
           FINSI;
           SI (EGA ICTOD 1);
             MESS 'PAS D INTERSECTION AVEC LA DROITE A 45°';
           FINSI;
         FINSI;
 
 
      SINON;
         CTOD.PF = 0;
         MESS 'RESOLUTION IMPOSSIBLE : DELTA < 0';
         SI (EGA ICTOD 1);
             MESS 'PAS D INTERSECTION AVEC LA DROITE A 45°';
         FINSI;
      FINSI;
    FINSI;
  SINON;
 
*------CAS OU L'ON SE TROUVE EN ELASTICITE :--------------*
*------PAS D'INTERSECTION AVEC LA DROITE A 45°------------*
*------CALCUL DU CTOD AVEC LE SIF K1 ---------------------*
    CTOD.PF = 0;
    MESS 'PAS D INTERSECTION AVEC LA DROITE A 45° : ';
  FINSI;
SI (EGA &DIM 3);
    SUPTAB.'CTOD'.PF = CTOD.PF;
SINON;
    SUPTAB.'CTOD' = CTOD.PF;
FINSI;
FIN BKTOTALE;
 
FINPROC SUPTAB ;
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales