C CCOEND SOURCE PV 17/12/08 21:15:16 9660 SUBROUTINE CCOEND(WRK52,WRK53,WRK2,ENDO0,NCOURB,NENDO,NRAPP) C COEND SOURCE AC2 96/04/17 21:15:03 2124 c SUBROUTINE COEND(WRK0,WRK2,ENDO0,NCOURB, c 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 DECHE -INC SMEVOLL -INC SMLREEL * 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