Sources Esope | Cast3M

clispp
C CLISPP    SOURCE    PV        22/04/22    21:15:06     11344          
      SUBROUTINE CLISPP(WRK52,WRK53,WRK54,WRK2,IFOU,IB,IGAU,
     1   NBPGAU,iecou)
C LISPP0    SOURCE    KICH      98/06/30    23:19:33     3239
c      SUBROUTINE LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,
c     1     KERRE,NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,
c     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(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     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(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=======================================================================
-INC CCREEL
-INC DECHE
      SEGMENT IECOU
*      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
       INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
     1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
     2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
     3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
     4  icow32,icow33,NSTRS1,icow35,NBGMAT,NELMAT,icow38,
C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
     5  icow39,icow40,icow41,icow42,icow43,icow44
C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
        INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
     .          icow51,icow52,icow53,icow54,icow55,icow56
     .          icow57,icow58
      ENDSEGMENT
 
      SEGMENT/WRK2/(TRAC(LTRAC)*D)
      SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
      PARAMETER(UNDEMI=.5D0,UN=1.D0)
      PARAMETER(SIX=6.D0)
      PARAMETER(NITERC=50)
      dimension crigi(12)
C
      PREC  = PRECIS*UNDEMI
      PRECM =-PRECIS*UNDEMI
C
      KERRE=0
C     ON RECUPERE L EPAISSEUR
C
*      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
         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 ccotra(wrk52,wrk2,NCOURB,wrk53)
            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
      nstrbi=nstrs1
      nbgmab=nbgmat
      nlmatb=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
      nstrs1=nstrbi
      nbgmat=nbgmab
      nelmat=nlmatb
*
      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
          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
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
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