1 : C CCOEND SOURCE PV 11/03/07 21:15:20 6885 2 : SUBROUTINE CCOEND(WRK52,WRK53,WRK2,ENDO0,NCOURB,NENDO,NRAPP) 3 : C COEND SOURCE AC2 96/04/17 21:15:03 2124 4 : c SUBROUTINE COEND(WRK0,WRK2,ENDO0,NCOURB, 5 : c 1 NENDO,NRAPP,KERRE) 6 : * 7 : ********************************************************************* 8 : * 9 : * Subroutine de trace de la courbe de traction 10 : * et de la courbe de debut d'endommagement 11 : * du modele d'endommagement P/Y 12 : * 13 : * ENTREES 14 : * - WRK0: segment sur les caracteristiques materiaux 15 : * - WRK2: segment sur la courbe de traction 16 : * - ENDO0: segment contenat la courbe de début d'endommagement 17 : * et la courbe d'évolution de l'endommagement 18 : * en fonction de la pseudo porosite 19 : * 20 : * SORTIES 21 : * - WRK2: segment sur la courbe de traction 22 : * - ENDO: courbe de debut d'endommagement 23 : * - RAPP: courbe d'évolution de l'endommagement 24 : * en fonction de la pseudo porosite 25 : * - NCOURB: nombre de points de la courbe de traction 26 : * - NENDO: nombre de points de la courbe de debut d'endommagement 27 : * - NRAPP: nombre de points de la courbe d'évolution de l'endommagement 28 : * en fonction de la pseudo porosite 29 : * 30 : ********************************************************************** 31 : * 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8(A-H,O-Z) 34 : * 35 : -INC DECHE 36 : -INC SMEVOLL 37 : -INC SMLREEL 38 : * 39 : SEGMENT/WRK2/(TRAC(LTRAC)*D) 40 : SEGMENT ENDO0 41 : REAL*8 ENDO(LENDO),RAPP(LENDO) 42 : ENDSEGMENT 43 : * 44 : DATA NCOMAX/130/ 45 : * 46 : *============================================== 47 : * Courbe de traction 48 : *============================================== 49 : * 50 : KERRE=0 51 : MEVOLL=nint(XMAT(5)) 52 : IF (MEVOLL.EQ.0) THEN 53 : KERRE=37 54 : RETURN 55 : ENDIF 56 : * 57 : SEGACT MEVOLL 58 : KEVOLL=IEVOLL(1) 59 : SEGACT KEVOLL 60 : MLREEL=IPROGX 61 : MLREE1=IPROGY 62 : SEGDES KEVOLL 63 : SEGACT MLREEL,MLREE1 64 : NBPOIX=PROG(/1) 65 : NBPOIY=MLREE1.PROG(/1) 66 : IF(NBPOIX.GT.NCOMAX+1) KERRE=31 67 : IF(NBPOIX.LT.3) KERRE=32 68 : IF(KERRE.EQ.0) GO TO 693 69 : 692 CONTINUE 70 : * 71 : * Erreur 72 : * 73 : SEGDES MLREEL,MLREE1 74 : SEGDES MEVOLL 75 : GO TO 777 76 : 693 CONTINUE 77 : * 78 : * TESTS SUR LES POINTS DE LA COURBE ( A COMPLETER ) 79 : * 80 : YUNG=XMAT(1) 81 : IF (YUNG.EQ.0.D0) THEN 82 : KERRE=34 83 : GO TO 692 84 : ENDIF 85 : PSIG=MLREE1.PROG(1) 86 : PEPS=PROG(1) 87 : IF (PSIG.NE.0.D0.OR.PEPS.NE.0.D0) THEN 88 : KERRE=35 89 : GO TO 692 90 : ENDIF 91 : * 92 : * VERIF DE LA LIMITE ELASTIQUE NON NULLE 93 : * 94 : PSIG =MLREE1.PROG(2) 95 : IF (PSIG.EQ.0.D0) THEN 96 : KERRE=30 97 : GO TO 692 98 : ENDIF 99 : PEPS=PROG(2) 100 : IF (PEPS.EQ.0.D0) THEN 101 : KERRE=35 102 : GO TO 692 103 : ENDIF 104 : PENTE=PSIG/PEPS 105 : RA=ABS(PENTE-YUNG)/YUNG 106 : IF (RA.GT.5.D-3) THEN 107 : KERRE=36 108 : GO TO 692 109 : ENDIF 110 : * 111 : * VERIF DE LA PENTE 112 : * 113 : DO 100 I=3,NBPOIX 114 : I1=I-1 115 : DEPS=PROG(I)-PROG(I1) 116 : IF(DEPS.EQ.0.D0) THEN 117 : KERRE=33 118 : GO TO 692 119 : ENDIF 120 : PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS 121 : IF(PENTE.GE.YUNG) THEN 122 : KERRE=33 123 : GO TO 692 124 : ENDIF 125 : 100 CONTINUE 126 : NCOURB=1 127 : TRAC(1)=MLREE1.PROG(2) 128 : TRAC(2)=0.D0 129 : DO 695 I=3,NBPOIX 130 : PEPS=PROG(I) 131 : PSIG=MLREE1.PROG(I) 132 : NCOURB=NCOURB+1 133 : TRAC(2*NCOURB-1)=PSIG 134 : TRAC(2*NCOURB)=PEPS-PSIG/YUNG 135 : 695 CONTINUE 136 : * 137 : SEGDES MLREEL,MLREE1 138 : SEGDES MEVOLL 139 : * 140 : *=============================================== 141 : * Trace de la courbe d'endommagement 142 : *=============================================== 143 : * 144 : MEVOLL=nint(XMAT(6)) 145 : IF(MEVOLL.EQ.0) THEN 146 : KERRE=37 147 : RETURN 148 : ENDIF 149 : * 150 : SEGACT MEVOLL 151 : KEVOLL=IEVOLL(1) 152 : SEGACT KEVOLL 153 : MLREEL=IPROGX 154 : MLREE1=IPROGY 155 : SEGDES KEVOLL 156 : SEGACT MLREEL,MLREE1 157 : NBPOIX=PROG(/1) 158 : NBPOIY=MLREE1.PROG(/1) 159 : IF(NBPOIX.GT.NCOMAX+1) KERRE=31 160 : IF(NBPOIX.LT.3) KERRE=32 161 : IF(KERRE.EQ.0) GO TO 10 162 : * 163 : * Erreur 164 : * 165 : SEGDES MLREEL,MLREE1 166 : SEGDES MEVOLL 167 : GO TO 777 168 : 10 CONTINUE 169 : * 170 : NENDO=0 171 : DO 20 I=1,NBPOIX 172 : NENDO=NENDO+1 173 : ENDO(2*NENDO-1)=MLREE1.PROG(I) 174 : ENDO(2*NENDO)=PROG(I) 175 : 20 CONTINUE 176 : * 177 : SEGDES MLREEL,MLREE1 178 : SEGDES MEVOLL 179 : * 180 : *==================================================== 181 : * Trace de la courbe d'évolution de l'endommagement 182 : *==================================================== 183 : * 184 : MEVOLL=nint(XMAT(7)) 185 : IF(MEVOLL.EQ.0) THEN 186 : KERRE=37 187 : RETURN 188 : ENDIF 189 : * 190 : SEGACT MEVOLL 191 : KEVOLL=IEVOLL(1) 192 : SEGACT KEVOLL 193 : MLREEL=IPROGX 194 : MLREE1=IPROGY 195 : SEGDES KEVOLL 196 : SEGACT MLREEL,MLREE1 197 : NBPOIX=PROG(/1) 198 : NBPOIY=MLREE1.PROG(/1) 199 : IF(NBPOIX.GT.NCOMAX+1) KERRE=31 200 : IF(NBPOIX.LT.3) KERRE=32 201 : IF(KERRE.EQ.0) GO TO 11 202 : * 203 : * Erreur 204 : * 205 : SEGDES MLREEL,MLREE1 206 : SEGDES MEVOLL 207 : GO TO 777 208 : 11 CONTINUE 209 : * 210 : NRAPP=0 211 : DO 21 I=1,NBPOIX 212 : NRAPP=NRAPP+1 213 : RAPP(2*NRAPP-1)=MLREE1.PROG(I) 214 : RAPP(2*NRAPP)=PROG(I) 215 : 21 CONTINUE 216 : * 217 : SEGDES MLREEL,MLREE1 218 : SEGDES MEVOLL 219 : * 220 : 777 CONTINUE 221 : RETURN 222 : END 223 : 224 : 225 : 226 : 227 : 228 : 229 : 230 : 231 :
© Cast3M 2003 - All rights reserved.
Disclaimer