1 : C ECOCRI SOURCE AM 13/12/16 21:15:27 7825 2 : SUBROUTINE ECOCRI(SIG0,VARIN0,VAREX0,XMAT,CRICRI, 3 : . CARAC,TRAC,KERRE,MFR,NSTRS,INPLAS, 4 : $ necou,ecou) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : C--------------------------------------------------------------------- 8 : C CRITERE POUR UN POINT 9 : C INSPIRE D'ECOINC 10 : C--------------------------------------------------------------------- 11 : C 12 : C EN ENTREE : 13 : C 14 : C SIG0 CONTRAINTES AU DEBUT DU PAS 15 : C VARIN0 VARIABLES INTERNES DEDUT DU PAS 16 : C VAREX0 VARIABLES EXTERNES DEBUT DU PAS 17 : C XMAT COEFFICIENTS DU MATERIAU 18 : C CARAC DES CARACTERISTIQUES 19 : C TRAC COURBE DE TRACTION 20 : C MFR INDICE DE FORMULATION 21 : C NSTRS NOMBRE DE CONTRAINTES CA2000 22 : C INPLAS NUMERO DU MODELE DE PLASTICITE 23 : C 24 : C EN SORTIE : 25 : C 26 : C CRICRI LE CRITERE 27 : C KERRE CODE D'ERREUR 28 : C = 0 SI TOUT OK 29 : C = 2 PROBLEME DANS LES CARACT DU TUYAU 30 : C = 38 NU DEVRAIT ETRE NUL 31 : C = 99 SI FORMULATION NON DISPONIBLE 32 : C 33 : C----------------------------------------------------------------------- 34 : -INC CCOPTIO 35 : SEGMENT ECOU 36 : *** COMMON/ECOU/TEST,ALFAH, 37 : REAL*8 TEST,ALFAH, 38 : C REAL*8 TEST, ALFAH, 39 : * 1 HPAS, TEMPS,ecow3(6),ecow4(9),ecow5(6), 40 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 41 : * 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 42 : * 2 ecow12(6), 43 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 44 : * 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), 45 : 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 46 : * 2 ecow17(6),ecow18(6),ecow19,ecow20 47 : 2 SIPLAD(6),DSIGP0(6),TET,TETI 48 : ENDSEGMENT 49 : 50 : SEGMENT NECOU 51 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 52 : INTEGER NCOURB, ncow2,IT,IMAPLA, ISOTRO, 53 : C INTEGER NCOURB,IPLAST,IT, IMAPLA,ISOTRO, 54 : 1 ITYP, IFOURB, IFLUAG, 55 : C . ITYP, IFOURB,IFLUAG, 56 : 2 ICINE,ITHER, IFLUPL,ICYCL, IBI, 57 : C . ICINE,ITHER, IFLUPL,ICYCL, IBI, 58 : 3 JFLUAG,KFLUAG, LFLUAG, 59 : C . JFLUAG,KFLUAG,LFLUAG, 60 : 4 IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEP 61 : C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 62 : ENDSEGMENT 63 : 64 : 65 : * COMMON/ECOU/TEST,ALFAH, 66 : * 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 67 : * 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 68 : * 1 DALPHA(6),DSIGO(6),E(12),XINV(3), 69 : * 2 SIPLAD(6),DSIGP0(6),TET,TETI 70 : C 71 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 72 : * . ITYP,IFOURB,IFLUAG, 73 : * . ICINE,ITHER,IFLUPL,ICYCL,IBI, 74 : * . JFLUAG,KFLUAG,LFLUAG, 75 : * . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 76 : C 77 : DIMENSION SIG0(*),VARIN0(*),XMAT(*), 78 : . VAREX0(*),CARAC(*),TRAC(*) 79 : DIMENSION SIGMA(6),DSIGMA(6),SPHER(6),AUXIL(6),DIV(7) 80 : DIMENSION ZBID(6),DSIGT(6) 81 : C ZZZZZZZZZZZZZZZZZZZZZZZ 82 : C DIMENSIONS A REVOIR 83 : C ZZZZZZZZZZZZZZZZZZZZZ 84 : DIMENSION SIG(30),EPS(30) 85 : DIMENSION ORMAT(1),ANORM(1) 86 : DIMENSION WORK(130) 87 : CHARACTER*8 CMATE 88 : 89 : DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/ 90 : DATA A,B,C,D/.577350269D0,.7071067814D0,.4082482904D0, 91 : . -0.8164965808D0/ 92 : DATA A1/1.D0/ 93 : DATA A2/.5D0/ 94 : DATA A3/3.D0/ 95 : CMATE='ISOTROPE' 96 : C----------------------------------------------------------------------- 97 : C CONVENTION DE REMPLISSAGE DES MEMOIRES : VOIR ECOINC 98 : C----------------------------------------------------------------------- 99 : C REMPLISSAGE 100 : C----------------------------------------------------------------------- 101 : CRICRI=0.D0 102 : IF(IMAPLA.EQ.0) RETURN 103 : YUNG=XMAT(1) 104 : XNU=XMAT(2) 105 : EPSM1=VARIN0(1) 106 : TIMEXI=VARIN0(1) 107 : DPSM1=VARIN0(1) 108 : DPSM2=VARIN0(1) 109 : EPENT=VARIN0(1) 110 : EPSFLU=VARIN0(1) 111 : TEMPS0=VAREX0(1) 112 : IT=nint(VAREX0(3)) 113 : TETI=VAREX0(2) 114 : IF(NCOURB.EQ.0) GO TO 5634 115 : DO 292 I=1,NCOURB 116 : SIG(I)=TRAC(2*I-1) 117 : 292 EPS(I)=TRAC(2*I) 118 : 5634 CONTINUE 119 : ORMAT(1)=XMAT(1) 120 : C---------------------------------------------------------------------- 121 : C INITIALISATIONS 122 : C---------------------------------------------------------------------- 123 : KERRE=0 124 : JA=1 125 : JC=1 126 : IA=1 127 : C 128 : C PETIT TEST SUR NU POUR CERTAINS CAS 129 : C 130 : IF(MFR.EQ.2.AND.IFOURB.EQ.-2.AND.XNU.NE.0.D0) THEN 131 : KERRE=38 132 : RETURN 133 : ENDIF 134 : DO 3648 I=1,6 135 : 3648 DSIGT(I)=0.D0 136 : CZZZZZZZZZZZZZ 137 : C PROVISOIRE 138 : CZZZZZZZZZZZZ 139 : ANORM(1)=XMAT(1) 140 : ICENT2=0 141 : IF(INPLAS.EQ.12.OR.INPLAS.EQ.13) ICENT2=1 142 : IF(INPLAS.EQ.7) NUMCHA=1 143 : IF(INPLAS.EQ.11) NUMCHA=2 144 : IF(INPLAS.EQ.12) NUMCHA=3 145 : IF(INPLAS.EQ.13) NUMCHA=4 146 : * 147 : * ON MET PRECIS A 1.D-3 148 : * 149 : PRECIS=1.D-3 150 : TEST=0.5D00*PRECIS 151 : MCOD=1 151 : CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL, 152 : . ZBID,ZBID,ZBID,ZBID,ZBID, 153 : . ZBID,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE,ecou,necou) 154 : IF(ITYP.EQ.0) THEN 155 : KERRE=99 156 : RETURN 157 : ENDIF 158 : C----------------------------------------------------------------------- 159 : IPLAST=0 160 : C 161 : C CAS DES COQUES EN GLOBAL - ON RECUPERE LE ALFAH 162 : C 163 : ALFAH=1.D0 164 : IF(ITYP.EQ.2) ALFAH=CARAC(2)**2 165 : IF(ITYP.EQ.7) ALFAH=CARAC(2)**2 166 : UNALF=0.D0 167 : IF(ALFAH.GE.1.D-12) UNALF=1.D0/ALFAH 168 : C 169 : C CAS DES POUTRES 170 : C 171 : IF(ITYP.NE.11) GO TO 841 172 : DIV(1)=1.D0/CARAC(4) 173 : DIV(2)=1.D0 174 : DIV(3)=1.D0 175 : DIV(4)=CARAC(10)/CARAC(1) 176 : DIV(5)=CARAC(11)/CARAC(2) 177 : DIV(6)=CARAC(12)/CARAC(3) 178 : GO TO 761 179 : 841 CONTINUE 180 : C 181 : C CAS DES TUYAUX 182 : C 183 : IF(ITYP.NE.12) GO TO 842 184 : EPAIS=CARAC(1) 185 : REXT=CARAC(2) 186 : RMOY=REXT-EPAIS*0.5D0 187 : RACO=CARAC(3) 188 : GAM=1.D0 189 : IF(RACO.EQ.0.D0) GO TO 765 190 : XLAM=RMOY*RMOY/EPAIS/RACO 191 : GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0 192 : IF(GAM.LT.1.D0) GAM=1.D0 193 : 765 CONTINUE 194 : C 195 : C NB 23/09/98 196 : C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY 197 : C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES 198 : C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS 199 : C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE 200 : C DUE A LA PRESSION ) 201 : C POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE 202 : C DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7) 203 : C 204 : DIV(1)=1.D0 205 : DIV(2)=1.D0 206 : DIV(3)=1.D0 207 : DIV(4)=R33 208 : DIV(5)=PI4*GAM 209 : DIV(6)=DIV(5) 210 : DIV(7)=0.D0 211 : IF(IDIM.EQ.2) THEN 212 : PRES1=CARAC(6) 213 : CISA1=CARAC(7) 214 : IXCAR1=12 215 : IDEB1=8 216 : ELSE IF(IDIM.EQ.3) THEN 217 : PRES1=CARAC(7) 218 : CISA1=CARAC(8) 219 : IXCAR1=13 220 : IDEB1=9 221 : ENDIF 222 : C 223 : JDIV1=2 224 : DO 1515 IBA=IDEB1,IXCAR1 225 : JDIV1=JDIV1+1 226 : VCAR1=CARAC(IBA) 227 : IF (VCAR1.NE.-1.D0) DIV(JDIV1)=CARAC(IBA) 228 : 1515 CONTINUE 229 : C 230 : C NB 23/09/98 231 : C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A 232 : C 1.D0 DE DIV(3) 233 : C 234 : DIV(1)=DIV(3) 235 : DIV(3)=1.D0 236 : C 237 : VX=CARAC(4) 238 : VY=CARAC(5) 239 : VZ=CARAC(6) 239 : CALL TUYCAR(CARAC,CISA1,VX,VY,VZ,KERRE,1) 240 : IF(KERRE.EQ.0) GO TO 843 241 : KERRE=2 242 : RETURN 243 : 843 CONTINUE 244 : DIV(1)=DIV(1)/CARAC(4) 245 : DIV(4)=DIV(4)*RMOY/CARAC(1) 246 : DIV(5)=DIV(5)*RMOY/CARAC(2) 247 : DIV(6)=DIV(6)*RMOY/CARAC(3) 248 : 761 CONTINUE 249 : IF(ITYP.NE.11) GO TO 842 250 : DO 762 IB=4,6 251 : IF(DIV(IB).NE.0.D0) GO TO 762 252 : DIV(IB)=1.D0 253 : 762 CONTINUE 254 : 842 CONTINUE 255 : C 256 : IF(ICINE.EQ.0.OR.JFLUAG.EQ.1) GO TO 204 257 : C 258 : C ON EST EN CINEMATIQUE ( PLASTIQUE OU FLUAGE ) 259 : C 260 : DO 206 IB=1,IBOU 261 : 206 SIGMA(IB)=SIGMA(IB)-SPHER(IB) 262 : 204 CONTINUE 263 : C 264 : IF(ITYP.NE.11.AND.ITYP.NE.12) GO TO 844 265 : DO 845 IB=1,IBOU 266 : SIGMA(IB)=SIGMA(IB)*DIV(IB) 267 : IF(ICINE.EQ.0) GO TO 845 268 : 845 SPHER(IB)=SPHER(IB)*DIV(IB) 269 : 844 CONTINUE 270 : DO 886 IB=1,IBOU 271 : 886 STOT(IB)=SIGMA(IB) 272 : C---------------------------------------------------------------------- 273 : C CALCUL DE LA LIMITE ELASTIQUE 274 : C---------------------------------------------------------------------- 275 : IF(IMAPLA.NE.4) GO TO 262 276 : BPSTAR=EPSM1 277 : ICOD=1 277 : CALL CHALIM(BPSTAR,SELAS,XMAT,TET,ICOD, 278 : . BID,BID,BID,BID,BID1,BID2,BI3,BI4,BI5,BI6,IBID,IBID,NUMCHA) 279 : GO TO 261 280 : 262 IF(IMAPLA.NE.5) GO TO 263 281 : SELAS=XMAT(7) 282 : GO TO 261 283 : 263 CONTINUE 284 : EPSTAR=EPSM1 285 : IF(ICINE.EQ.1) EPSTAR=0. 285 : CALL TRACTI(SELAS,EPSTAR,SIG,EPS,NCOURB,2,IBI) 286 : IF(IBI.EQ.1) THEN 287 : KERRE=75 288 : RETURN 289 : ENDIF 290 : 261 CONTINUE 291 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 292 : C A VOIR CE QU'IL Y A DANS ANORM 293 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 294 : IF(IMAPLA.EQ.7) COVNMS(1)=ANORM(2*JC-1) 295 : IF(IMAPLA.EQ.7.AND.IT.EQ.1) ANORM(2*JC)=1.E-20 296 : CCCCCCCCCCCCC SI MATERIAU DRUCKER PRAGER ON CHERCHE LE CRITERE 297 : C AVEC LEQUEL ON DOIT FAIRE LA PROJECTION ET LE CRITERE 298 : IXMAT=5 299 : IF(IMAPLA.EQ.5.AND.EPSM1.EQ.0.) IXMAT=10 299 : CALL CKRIT(IMAPLA,STOT,ITYP,XMAT(IXMAT),ALFAH,COVNMS,XINV,SSTAR) 300 : C--------------------------------------------------------------------- 301 : C CALCUL DU CRITERE 302 : C--------------------------------------------------------------------- 303 : CRICRI=SSTAR-SELAS 304 : 31 CONTINUE 305 : RETURN 306 : END 307 : 308 : 309 : 310 : 311 : 312 : 313 : 314 : 315 : 316 :
© Cast3M 2003 - All rights reserved.
Disclaimer