Sources Esope | Cast3M

clispp
C CLISPP    SOURCE    OF166741  25/11/04    21:15:26     12349          
      SUBROUTINE CLISPP(WRK52,WRK53,WRK54,WRK2,IFOU,IB,IGAU,
     1   NBPGAU,iecou)
 
C======================================================================
C     PLASTICITE LINESPRING
C
C ENTREES
C     SIG0(NSTRS1) = CONTRAINTES INITIALES
C     NSTRS1       = NOMBRE DE CONTRAINTES
C     DEPST(NSTRS1)= INCREMENT DE DEFORMATIONS TOTALES
C     VAR0(NVARI) =  VARIABLES INTERNES   DEBUT
C     XMAT(NCOMAT)=  COMPOSANTES DE MATERIAU
C     NCOMAT      = NOMBRE DE COMPOSANTES DE MATERIAU
C     xcarb(ICARA) =  CARACTERISTIQUES
C     ICARA       = NOMBRE DE CARACTERISTIQUES
C     MALI        = NUMERO DU MATERIAU LINEAIRE
C     INPLAS      = NUMERO DU MATERIAU PLASTIQUE
C     NCOURT      =   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(NSTRS1)   = CONTRAINTES FINALES   ET J
C     VARF(NVARI)   = VARIABLES INTERNES FINALES
C     DEFP(NSTRS1)   = 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=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC CCREEL
-INC DECHE
-INC TECOU
 
      SEGMENT/WRK2/(TRAC(LTRAC)*D)
      SEGMENT/WORK/(SIG(nccor)*D,XLAM(nccor)*D)
 
      PARAMETER(UNDEMI=.5D0,UN=1.D0,SIX=6.D0)
      PARAMETER(NITERC=50)
      dimension crigi(12)
C
      PREC  = PRECIS*UNDEMI
      PRECM =-PRECIS*UNDEMI
C
      KERRE = 0
 
C     ON RECUPERE L EPAISSEUR
*      write(6,*) ' entree dans clispp iecou', iecou
      W  = xcarb(1)
      FI = xcarb(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
         NCOURT=2
         TRAC(1)=XMAT(5)
         TRAC(2)=XZERO
         TRAC(3)=XMAT(5)
         TRAC(4)=UN
      ELSE
CCC   CAS DE LA PLASTICITE AVEC ECROUISSAGE
C  ON CALCULE LA RAIDEUR KMM ET ON REMPLIT XMAT(1)=KMM POUR VERIF
C   PENTE A L ORIGINE DE LA COURBE (M,PHI)
         IF(INPLAS.EQ.27) THEN
            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
            nccor = 0
            call ccotra(wrk52,wrk2,nccor,wrk53)
            IF (KERRE.NE.0) RETURN
            XMAT(1)=YOU
            NCOURT = nccor
         ENDIF
         PMOMM=TRAC(2*NCOURT-1)
         IF(PMOMM.EQ.0.D0) THEN
            KERRE=30
            RETURN
         ENDIF
C
C  ON CALCULE SIG0 POUR LE MOMENT MAXI
C
         XM0SS0=W*W*0.25D0
         CALL LISPML(QSI,A)
         VSIG0=PMOMM/(XM0SS0*A)
         DO 100 I=1,NCOURT
            TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
 100     CONTINUE
      ENDIF
C
C   REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
C
      nccor = NCOURT
      SEGINI WORK
      DO 2 I=1,nccor
         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,nccor,2,IBI)
      IF (IBI.EQ.1) THEN
        KERRE=75
        GOTO 666
      ENDIF
C
C     CALCUL DES INCREMENTS DE CONTRAINTES
C
      nstrbi=iecou.nstrss
      nbgmab=iecou.nbgmat
      nlmatb=iecou.nelmat
*      write(6,*) ' clispp  appel a calsig mfr ', mfr
      CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR,
     1     N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU,
     2     MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,
     3     XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
*       write(6,*) ' clispp apres calsig irtd ',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,rA,rB,rC,rD,rE,rF)
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=(rA*XNT+rB*XMT+rE)*DNT+(rB*XNT+rD*XMT+rF)*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= (rA*XNTRA+rB*XMTRA+rE)*DNT
     &             +(rB*XNTRA+rD*XMTRA+rF)*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
          prec1 = PRECIS
          kerre1 = KERRE
         CALL LISPP1(XNTRA,XMTRA,XNT,XMT,QSI,W,YOU,XNU,WORK,
     1        XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1)
          PRECIS = prec1
          KERRE = kerre1
C
 444     CONTINUE
      ELSE IF(Q1.GT.PRECM.AND.Q1.LE.PREC.AND.Q2.GT.PREC) THEN
C
C    ON INTEGRE
C
          prec1 = PRECIS
          kerre1 = KERRE
         CALL LISPP1(XN0,XM0,XNT,XMT,QSI,W,YOU,XNU,WORK,
     1        XLAM0,prec1,XNE,XME,XNP,XMP,DLAM,kerre1)
          PRECIS = prec1
          KERRE = kerre1
C
      ENDIF
C
C     ON TRANSFORME LES EFFORTS EN CONTRAINTES 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= SQRT(XPI*FI)
         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
 
 666  CONTINUE
      RETURN
      END