Sources Esope | Cast3M

lispp1
C LISPP1    SOURCE    CHAT      05/01/13    01:23:10     5004
      SUBROUTINE LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK,
     1   XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE)
C=======================================================================
C     CALCULE L ECOULEMENT PLASTIQUE DANS LE CAS DU LINESPRING
C   ENTREES
C    XN0,XM0   = EFFORTS SUR LE DEBUT DU PAS
C    XNT,XMT   = EFFORTS TOATAUX
C    QSI       = RAPPORT PROFONDEUR DE FISSURE SUR EPAISSEUR
C    W         = EPAISSEUR LINESPRING
C    YOU       = MODULE D YOUNG
C    XNU       = COEFFICIENT DE POISSON
C    SIG,XLAM  = COURBE (SIG0,PHIP)
C    NCOURB    = NOMBRE DE POINTS DE LA COURBE DE TRACTION
C    XLAM0     = PARAMETRE D ECROUISSAGE AU DEBUT DU PAS
C    PRECIS    = PRECISION DES ITERATIONS
C   SORTIES
C    XNE,XME   = EFFORTS FIN DU PAS SUR SURFACE DE CHARGE
C    XNP,XMP   = DEFORMATIONS PLASTIQUES     FIN DU PAS
C    DLAM      = INCREMENT SUR LE PAS DU PARAMETRE D ECROUISSAGE
C    KERRE     = INDICATEUR D ERREUR
C     EBERSOLT      AVRIL 86
C     REVISION  J. BROCHARD  AOUT 90     ECOULEMENT NON ASSOCIE
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
      PARAMETER(UNSIX=.166666666666666D0,SIX=6.D0)
      PARAMETER(DEUX=2.D0,UNDEMI=.5D0,UN=1.D0,XZER=0.D0)
      PARAMETER(NITER=50,PENA=1.D6,EPSINV=1.D-3)
C
      PREC=PRECIS*UNDEMI
      IBI=0
C
C
C    ON CALCULE LES PARAMETRES DE L ECOULEMENT
C
      NCOURB=SIG(/1)
      CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        RETURN
      ENDIF
      CALL LISPPA(QSI,W,SIGMA0,GA,GB,A,B,C,D,E,F)
C
C     CALCUL DE LA MATRICE DE HOOKE
C
      DD2 = YOU*UNDEMI/(UN-XNU*XNU)
      IF(QSI.GT.EPSINV) THEN
      CALL LISPAL(QSI,ALMM,ALMF,ALFF,DELTA)
C
      DDD = DD2/DELTA
      D11 = ALFF * DDD
      D12 =-ALMF * DDD  * W * UNSIX
      D21 =-ALMF * DDD  * W * UNSIX
      D22 = ALMM * DDD  * W * W * UNSIX * UNSIX
      ELSE
      D11 =DD2*PENA*W
      D22 =DD2*PENA*W*W*W*UNSIX*UNDEMI
      D12 =XZER
      D21 =XZER
      ENDIF
C
C     VARIABLE D ECROUISSAGE : ROTATION PLASTIQUE
C     RECHERCHE DE LA SOLUTION PAR DICHOTOMIE
C     ENTRE LE CAS TOUT ELASTIQUE ET LE CAS TOUT PLASTIQUE
C
      XNE1=XNT
      XME1=XMT
      XNP1=XZER
      XMP1=XZER
      XLAM1=XLAM0
      CALL LISPQ(XNE1,XME1,W,SIGMA0,GA,GB,QSI,Q1)
      XNE2=XN0
      XME2=XM0
      XX1=XNT - XN0
      XX2=XMT - XM0
      DDX=  2.D0*(1.D0 -XNU* XNU)/YOU
      XNP2= ALMM*XX1       + ALMF*XX2*SIX/W
      XMP2= ALMF*XX1*SIX/W + ALFF*XX2*SIX*SIX/(W*W)
      XNP2= XNP2*DDX
      XMP2= XMP2*DDX
      ALPH= XNP2 / XMP2
      XLAM2=XLAM0+ABS(XMP2)
      CALL TRACTI(SIGMA2,XLAM2,SIG,XLAM,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        RETURN
      ENDIF
      CALL LISPQ(XNE2,XME2,W,SIGMA2,GA,GB,QSI,Q2)
      IF(ABS(Q2).LT.PREC) THEN
      XNE3=XNE2
      XME3=XME2
      XNP3=XNP2
      XMP3=XMP2
      GOTO 200
      ENDIF
      NBIT=0
100   CONTINUE
      NBIT=NBIT+1
      IF(NBIT.GT.NITER) THEN
C
C     PAS DE CONVERGENCE EN MOINS DE NITER ITERATIONS
C
      KERRE=2
      RETURN
      ENDIF
      DQ = (Q2 - Q1) / (XMP2 - XMP1)
      XMP3= XMP1 - Q1 / DQ
      XNP3= ALPH * XMP3
      XNE3=XNT - D11*XNP3 - D12*XMP3
      XME3=XMT - D21*XNP3 - D22*XMP3
      XLAM3=XLAM0+ABS(XMP3)
      CALL TRACTI(SIGMA3,XLAM3,SIG,XLAM,NCOURB,2,IBI)
      IF(IBI.EQ.1) THEN
        KERRE=75
        RETURN
      ENDIF
      CALL LISPQ(XNE3,XME3,W,SIGMA3,GA,GB,QSI,Q3)
      IF(ABS(Q3).LT.PREC) GOTO 200
      IF ((Q1*Q3).LT.XZER) THEN
         XNP2=XNP3
         XMP2=XMP3
         Q2=Q3
         GOTO 100
      ENDIF
      IF ((Q2*Q3).LT.XZER) THEN
         XNP1=XNP3
         XMP1=XMP3
         Q1=Q3
         GOTO 100
      ENDIF
C
C
C     ON A CONVERGE EN MOINS DE NITER ITERATIONS
C
  200 CONTINUE
      XNE=XNE3
      XME=XME3
      XNP=XNP3
      XMP=XMP3
      DLAM=ABS(XMP)
C
      RETURN
      END