Sources Esope | Cast3M

lispp1
C LISPP1    SOURCE    OF166741  24/10/21    21:15:15     12042          
 
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=======================================================================
      SUBROUTINE LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK,
     &   XLAM0,PRECIS,XNE,XME,XNP,XMP,DLAM,KERRE)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      SEGMENT WORK
        REAL*8 SIG(NCOURB),XLAM(NCOURB)
      ENDSEGMENT
 
      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)
 
      PREC=PRECIS*UNDEMI
      IBI=0
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)
        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
c*        D22 = D11 * 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*(UN-XNU*XNU)/YOU
      DDX=  UN / DD2
      XNP2= ALMM*XX1       + ALMF*XX2*SIX/W
      XMP2= ALMF*XX1*SIX/W + ALFF*XX2*SIX*SIX/(W*W)
      ALPH= XNP2 / XMP2
      XNP2= XNP2*DDX
      XMP2= XMP2*DDX
      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