Sources Esope | Cast3M

coend
C COEND     SOURCE    PV        11/03/07    21:15:37     6885
      SUBROUTINE COEND(WRK0,WRK2,ENDO0,NCOURB,
     1                 NENDO,NRAPP,KERRE)
*
*********************************************************************
*
*  Subroutine de trace de la courbe de traction
*  et de la courbe de debut d'endommagement
*  du modele d'endommagement P/Y
*
*  ENTREES
*    - WRK0: segment sur les caracteristiques materiaux
*    - WRK2: segment sur la courbe de traction
*    - ENDO0: segment contenat la courbe de début d'endommagement
*             et la courbe d'évolution de l'endommagement
*             en fonction de la pseudo porosite
*
*  SORTIES
*    - WRK2: segment sur la courbe de traction
*    - ENDO: courbe de debut d'endommagement
*    - RAPP: courbe d'évolution de l'endommagement
*             en fonction de la pseudo porosite
*    - NCOURB: nombre de points de la courbe de traction
*    - NENDO: nombre de points de la courbe de debut d'endommagement
*    - NRAPP: nombre de points de la courbe d'évolution de l'endommagement
*             en fonction de la pseudo porosite
*
**********************************************************************
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC SMEVOLL
-INC SMLREEL
*
      SEGMENT/WRK0/(XMAT(NCOMAT)*D)
      SEGMENT/WRK2/(TRAC(LTRAC)*D)
      SEGMENT ENDO0
        REAL*8 ENDO(LENDO),RAPP(LENDO)
      ENDSEGMENT
*
      DATA NCOMAX/130/
*
*==============================================
*  Courbe de traction
*==============================================
*
      KERRE=0
      MEVOLL=nint(XMAT(5))
      IF (MEVOLL.EQ.0) THEN
         KERRE=37
         RETURN
      ENDIF
*
      SEGACT MEVOLL
      KEVOLL=IEVOLL(1)
      SEGACT KEVOLL
      MLREEL=IPROGX
      MLREE1=IPROGY
      SEGDES KEVOLL
      SEGACT MLREEL,MLREE1
      NBPOIX=PROG(/1)
      NBPOIY=MLREE1.PROG(/1)
      IF(NBPOIX.GT.NCOMAX+1) KERRE=31
      IF(NBPOIX.LT.3)        KERRE=32
      IF(KERRE.EQ.0) GO TO 693
 692  CONTINUE
*
*   Erreur
*
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
      GO TO 777
 693  CONTINUE
*
*   TESTS SUR LES POINTS DE LA COURBE   ( A COMPLETER )
*
      YUNG=XMAT(1)
      IF (YUNG.EQ.0.D0) THEN
         KERRE=34
         GO TO 692
      ENDIF
      PSIG=MLREE1.PROG(1)
      PEPS=PROG(1)
      IF (PSIG.NE.0.D0.OR.PEPS.NE.0.D0) THEN
         KERRE=35
         GO TO 692
      ENDIF
*
*  VERIF DE LA LIMITE ELASTIQUE NON NULLE
*
      PSIG =MLREE1.PROG(2)
      IF (PSIG.EQ.0.D0) THEN
         KERRE=30
         GO TO 692
      ENDIF
      PEPS=PROG(2)
      IF (PEPS.EQ.0.D0) THEN
         KERRE=35
         GO TO 692
      ENDIF
      PENTE=PSIG/PEPS
      RA=ABS(PENTE-YUNG)/YUNG
      IF (RA.GT.5.D-3) THEN
         KERRE=36
         GO TO 692
      ENDIF
*
*  VERIF DE LA PENTE
*
      DO 100 I=3,NBPOIX
         I1=I-1
         DEPS=PROG(I)-PROG(I1)
         IF(DEPS.EQ.0.D0) THEN
            KERRE=33
            GO TO 692
         ENDIF
         PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS
         IF(PENTE.GE.YUNG) THEN
            KERRE=33
            GO TO 692
         ENDIF
 100  CONTINUE
      NCOURB=1
      TRAC(1)=MLREE1.PROG(2)
      TRAC(2)=0.D0
      DO 695 I=3,NBPOIX
         PEPS=PROG(I)
         PSIG=MLREE1.PROG(I)
         NCOURB=NCOURB+1
         TRAC(2*NCOURB-1)=PSIG
         TRAC(2*NCOURB)=PEPS-PSIG/YUNG
  695 CONTINUE
*
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
*
*===============================================
*  Trace de la courbe d'endommagement
*===============================================
*
      MEVOLL=nint(XMAT(6))
      IF(MEVOLL.EQ.0) THEN
         KERRE=37
         RETURN
      ENDIF
*
      SEGACT MEVOLL
      KEVOLL=IEVOLL(1)
      SEGACT KEVOLL
      MLREEL=IPROGX
      MLREE1=IPROGY
      SEGDES KEVOLL
      SEGACT MLREEL,MLREE1
      NBPOIX=PROG(/1)
      NBPOIY=MLREE1.PROG(/1)
      IF(NBPOIX.GT.NCOMAX+1) KERRE=31
      IF(NBPOIX.LT.3)        KERRE=32
      IF(KERRE.EQ.0) GO TO 10
*
*   Erreur
*
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
      GO TO 777
 10   CONTINUE
*
      NENDO=0
      DO 20 I=1,NBPOIX
         NENDO=NENDO+1
         ENDO(2*NENDO-1)=MLREE1.PROG(I)
         ENDO(2*NENDO)=PROG(I)
  20  CONTINUE
*
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
*
*====================================================
*  Trace de la courbe d'évolution de l'endommagement
*====================================================
*
      MEVOLL=nint(XMAT(7))
      IF(MEVOLL.EQ.0) THEN
         KERRE=37
         RETURN
      ENDIF
*
      SEGACT MEVOLL
      KEVOLL=IEVOLL(1)
      SEGACT KEVOLL
      MLREEL=IPROGX
      MLREE1=IPROGY
      SEGDES KEVOLL
      SEGACT MLREEL,MLREE1
      NBPOIX=PROG(/1)
      NBPOIY=MLREE1.PROG(/1)
      IF(NBPOIX.GT.NCOMAX+1) KERRE=31
      IF(NBPOIX.LT.3)        KERRE=32
      IF(KERRE.EQ.0) GO TO 11
*
*   Erreur
*
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
      GO TO 777
 11   CONTINUE
*
      NRAPP=0
      DO 21 I=1,NBPOIX
         NRAPP=NRAPP+1
         RAPP(2*NRAPP-1)=MLREE1.PROG(I)
         RAPP(2*NRAPP)=PROG(I)
  21  CONTINUE
*
      SEGDES MLREEL,MLREE1
      SEGDES MEVOLL
*
  777 CONTINUE
      RETURN
      END