Sources Esope | Cast3M

lispp0
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