C LISPP0 SOURCE BP208322 17/03/01 21:17:49 9325 SUBROUTINE LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS, 1 KERRE,NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST, 2 MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C====================================================================== C PLASTICITE LINESPRING C C ENTREES C SIG0(NSTRS) = CONTRAINTES INITIALES C NSTRS = NOMBRE DE CONTRAINTES C DEPST(NSTRS)= INCREMENT DE DEFORMATIONS TOTALES C VAR0(NVARI) = VARIABLES INTERNES DEBUT C XMAT(NCOMAT)= COMPOSANTES DE MATERIAU C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU C XCAR(ICARA) = CARACTERISTIQUES C ICARA = NOMBRE DE CARACTERISTIQUES C MALI = NUMERO DU MATERIAU LINEAIRE C INPLAS = NUMERO DU MATERIAU PLASTIQUE C NCOURB = NOMBRE DE POINTS SUR LA COURBE DE TRACTION C TRAC = COURBE DE TRACTION C PRECIS = PRECISION DES ITERATIONS * CMATE = NOM DU MATERIAU * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE * MFR = NUMERO DE LA FORMULATION * IFOU = OPTION DE CALCUL * IB = NUMERO DE L ELEMENT COURANT * IGAU = NUMERO DU POINT COURANT * EPAIST= EPAISSEUR * NBPGAU= NBRE DE POINTS DE GAUSS * MELE = NUMERO DE L ELEMENT FINI * NPINT = NBRE DE POINTS D INTEGRATION * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES * SECT = SECTION * LHOOK = TAILLE DE LA MATRICE DE HOOKE * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE C C SORTIES C SIGF(NSTRS) = CONTRAINTES FINALES ET J C VARF(NVARI) = VARIABLES INTERNES FINALES C DEFP(NSTRS) = DEFORMATIONS PLASTIQUES C KERRE = 0 TOUT OK C 1 SI DLAMBDA NEGATIF C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE C 30 LIMITE ELASTIQUE NULLE C 75 SORTIE DE LA COURBE DE TRACTION C======================================================================= -INC CCREEL SEGMENT/WRK0/(XMAT(NCXMAT)*D) SEGMENT/WRK1/(DDHOOK(LHOOK,LHOOK)*D,SIG0(NSTRS)*D, . DEPST(NSTRS)*D,SIGF(NSTRS)*D,VAR0(NVARI)*D, . VARF(NVARI)*D,DEFP(NSTRS)*D,XCAR(ICARA)*D) SEGMENT/WRK2/(TRAC(LTRAC)*D) SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D) SEGMENT/WTRAV/(DDAUX(LHOOK,LHOOK)*D,VALMAT(NUMAT)*D, . VALCAR(NUCAR)*D,DSIGT(NSTRS)*D,TXR(IDIM,IDIM)*D, . DDHOMU(LHOOK,LHOOK)*D,XLOC(3,3)*D, . XGLOB(3,3)*D,D1HOOK(LHOOK,LHOOK)*D, . ROTHOO(LHOOK,LHOOK)*D) PARAMETER(UNDEMI=.5D0,UN=1.D0) PARAMETER(SIX=6.D0) PARAMETER(NITERC=50) C DIMENSION CRIGI(*) CHARACTER*8 CMATE PREC = PRECIS*UNDEMI PRECM =-PRECIS*UNDEMI C KERRE=0 C ON RECUPERE L EPAISSEUR C W = XCAR(1) FI = XCAR(2) QSI= FI / W C C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP) C YOU =XMAT(1) XNU =XMAT(2) IF(INPLAS.EQ.2) THEN CCC CAS DE LA PLASTICITE PARFAITE IF(XMAT(5).EQ.XZERO) THEN KERRE=30 RETURN ENDIF NCOURB=2 TRAC(1)=XMAT(5) TRAC(2)=XZERO TRAC(3)=XMAT(5) TRAC(4)=UN ELSE IF(INPLAS.EQ.27) THEN CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE C C ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF C PENTE A L ORIGINE DE LA COURBE (M,PHI) C CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA) DDX= 2.D0*(1.D0 -XNU* XNU)/YOU CMM= ALFF*DDX*SIX*SIX/(W*W) XMAT(1)=1.D0/CMM CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) XMAT(1)=YOU IF(KERRE.NE.0) RETURN ENDIF PMOMM=TRAC(2*NCOURB-1) IF(PMOMM.EQ.0.D0) THEN KERRE=30 RETURN ENDIF C C ON CALCULE SIG0 POUR LE MOMENT MAXI C XM0SS0=W*W/4.D0 CALL LISPML(QSI,A) VSIG0=PMOMM/XM0SS0/A DO 100 I=1,NCOURB TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0 100 CONTINUE ENDIF C C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP) C SEGINI WORK DO 2 I=1,NCOURB SIG(I)=TRAC(2*I-1) XLAM(I)=TRAC(2*I) 2 CONTINUE C C ON RECUPERE LES VARIABLES INTERNES C XLAM0=VAR0(1) IBI=0 CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI) IF(IBI.EQ.1) THEN KERRE=75 GOTO 666 ENDIF C C CALCUL DES INCREMENTS DE CONTRAINTES C CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR, 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU, 2 MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC, 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) * IF(IRTD.NE.1) THEN KERRE=69 GOTO 666 ENDIF * C C ON TRAVAILLE AVEC LES 2 CONTRAINTES MEMBRANE ET FLEXION C SOLLICITANT LA FISSURE SIGF(2)=DSIGT(2) + SIG0(2) SIGF(3)=DSIGT(3) + SIG0(3) SIGF(5)=DSIGT(5) + SIG0(5) DEFP(2)=XZERO DEFP(3)=XZERO DEFP(5)=XZERO C C ON CALCULE LES PARAMETRES POUR CALCULER LE CRITERE C ET SA DERIVEE CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F) C XN0=SIG0(1) XM0=SIG0(4) DNT=DSIGT(1) DMT=DSIGT(4) XNT=XN0+DNT XMT=XM0+DMT C C POSITION DE XN0 XM0 XNT XMT DANS OU HORS DE LA SURFACE DE CHARGE C CALL LISPQ(XN0,XM0,W,SIGMA0,GA,GB,QSI,Q1) CALL LISPQ(XNT,XMT,W,SIGMA0,GA,GB,QSI,Q2) C IF(Q1.GT.PREC) THEN KERRE=22 ELSE IF(Q1.LE.PREC.AND.Q2.LE.PREC) THEN XNE =XNT XME =XMT XNP=XZERO XMP=XZERO DLAM=XZERO C ELSE IF(Q1.LE.PRECM.AND.Q2.GT.PREC) THEN C C ON CHERCHE INTERSECTION AVEC SURFACE DE CHARGE C DQDLAM=(A*XNT+B*XMT+E)*DNT+(B*XNT+D*XMT+F)*DMT DLAM= 1.D0 - Q2 / DQDLAM DO 101 IA=1,NITERC XNTRA=XN0+DLAM*DNT XMTRA=XM0+DLAM*DMT CALL LISPQ(XNTRA,XMTRA,W,SIGMA0,GA,GB,QSI,QQ) DQDLAM=(A*XNTRA+B*XMTRA+E)*DNT+(B*XNTRA+D*XMTRA+F)*DMT DLA1=DLAM - QQ / DQDLAM XNN = ABS(DLA1-DLAM) DLAM=DLA1 IF(XNN.LT.PREC) GOTO 200 101 CONTINUE C C ON NE TROUVE PAS XN0 XM0 EN MOINS DE NITERC ITERATIONS C KERRE=21 GOTO 444 200 CONTINUE C C ON INTEGRE C C CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK, 1 XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE) C C 444 CONTINUE ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN C C ON INTEGRE C CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK, 1 XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE) C C ENDIF C C ON TRANSFORME LES EFFORTS EN CONTRAINTES C ET ON RECALCULE KI IF(KERRE.EQ.0) THEN SIGF(1)=XNE S1=XNE/W SIGF(4)=XME S4=XME*SIX/(W*W) C CALL LISPFI(QSI,FM,FF) XXX=XPI*FI XXX = SQRT(XXX) XKIEL = XXX*(FM*S1+FF*S4) C DEFP(1)=XNP DEFP(4)=2.D0*XMP/W C CALL LISPDF(XNE,XME,GA,GB,QSI,W,SIGMA0,DFIDQS,DFIDM) VARF(1)=ABS(DLAM)+VAR0(1) DJP=DFIDQS*DLAM/DFIDM/W VARF(2)=VAR0(2)+DJP C DEFP(6)=DJP SIGF(6)=XKIEL ENDIF C 666 RETURN END