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