1 : C CTUFPL SOURCE PV 11/03/07 21:16:13 6885 2 : SUBROUTINE CTUFPL(WRK52,WRK53,WRK54,WRK2, 3 : 1 IFOU,IB,IGAU,NBPGAU,iecou) 4 : C TUFPLA SOURCE KICH 98/07/01 00:32:42 3239 5 : c SUBROUTINE TUFPLA(WRK1,WRK0,WRK2,WTRAV,MAPL,PRECIS, 6 : c 1 NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB, 7 : c 2 IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT, 8 : c 3 NBPGAU,SECT,LHOOK,CRIGI,KERRE) 9 : * 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : C---------------------------------------------------------------------- 13 : C PLASTICITE TUYAU FISSURE 14 : C CE SOUS PROGRAMME EST APPELE PAR PLAST 15 : C 16 : C ENTREES 17 : C SIG0(NSTRS1) = CONTRAINTES INITIALES 18 : C NSTRS1 = NOMBRE DE CONTRAINTES 19 : C DEPST(NSTRS1)= INCREMENT DE CONTRAINTES TOTALES 20 : C VAR0(NVARI) = VARIABLES INTERNES DEBUT 21 : C NVARI = NOMBRE DE VARIABLES INTERNES 22 : C XMAT(NCXMAT)= COMPOSANTES DE MATERIAU 23 : C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU 24 : C xcarb(ICARA) = CARACTERISTIQUES 25 : C ICARA = NOMBRE DE CARACTERISTIQUES 26 : C MAPL = NUMERO DU MATERIAU PLASTIQUE 27 : C NPOITR = NOMBRE DE POINT SUR LA COURBE DE TRACTION 28 : C PRECIS = PRECISION DES ITERATIONS 29 : * CMATE = NOM DU MATERIAU 30 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE 31 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE 32 : * MFR1 = NUMERO DE LA FORMULATION 33 : * IFOU = OPTION DE CALCUL 34 : * IB = NUMERO DE L ELEMENT COURANT 35 : * IGAU = NUMERO DU POINT COURANT 36 : * EPAIST= EPAISSEUR 37 : * NBPGAU= NBRE DE POINTS DE GAUSS 38 : * MELE = NUMERO DE L ELEMENT FINI 39 : * NPINT = NBRE DE POINTS D INTEGRATION 40 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES 41 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES 42 : * SECT = SECTION 43 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE 44 : * 45 : C SORTIES 46 : C SIGF(NSTRS1) = CONTRAINTES FINALES 47 : C VARF(NVARI) = VARIABLES INTERNES FINALES 48 : C DEFP(NSTRS1) = DEFORMATIONS PLASTIQUES 49 : C KERRE = 0 TOUT OK 50 : C 1 SI DLAMBDA NEGATIF 51 : C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE 52 : C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG 53 : C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE 54 : C 30 LIMITE ELASTIQUE NULLE 55 : C 34 MODULE D YOUNG NUL 56 : C 75 SORTIE DE LA COURBE DE TRACTION 57 : C----------------------------------------------------------------------- 58 : -INC CCREEL 59 : *- 60 : -INC CCOPTIO 61 : -INC SMEVOLL 62 : -INC SMLREEL 63 : -INC DECHE 64 : SEGMENT IECOU 65 : * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 66 : INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7, 67 : C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK, 68 : 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16, 69 : C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND, 70 : 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24, 71 : C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT, 72 : 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31, 73 : C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA, 74 : 4 icow32,icow33,NSTRS1,MFR1,NBGMAT,NELMAT,icow38, 75 : C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA, 76 : 5 icow39,icow40,icow41,icow42,icow43,icow44 77 : C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME 78 : INTEGER icow45,icow46,icow47,icow48,icow49,icow50, 79 : . icow51,icow52,icow53,icow54,icow55,icow56 80 : . icow57,icow58 81 : ENDSEGMENT 82 : SEGMENT/WRK2/(TRAC(LTRAC)*D) 83 : SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D) 84 : DIMENSION DTUFI(2,2),CTUFI(2,2),CRIGI(12) 85 : C 86 : MAPL = INPLAS 87 : KERRE=0 88 : NSTRS1=SIG0(/1) 89 : NVARI=VAR0(/1) 90 : C 91 : C ON RECUPERE LES CONSTANTES 92 : C 93 : EPAI=xcarb(2) 94 : RAYOM=xcarb(1)-EPAI/2.D0 95 : THETA0=xcarb(9)*XPI/360.D0 96 : C 97 : C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP) 98 : C 99 : YOUN=XMAT(1) 100 : JDA=nint(XMAT(6)) 101 : IF(MAPL.EQ.14) THEN 102 : CCC CAS DE LA PLASTICITE PARFAITE 103 : IF(XMAT(5).EQ.XZERO) THEN 104 : KERRE=30 105 : RETURN 106 : ENDIF 107 : NCOURB=2 108 : TRAC(1)=XMAT(5) 109 : TRAC(2)=XZERO 110 : TRAC(3)=XMAT(5) 111 : TRAC(4)=1.D0 112 : ELSE 113 : IF(MAPL.EQ.18) THEN 114 : CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE 115 : C 116 : C ON CALCULE LA COMPLAISANCE CMM ET ON REMPLIT XMAT(1)=CMM POUR VERIF 117 : C PENTE A L ORIGINE DE LA COURBE (M,PHI) 118 : C 118 : CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI) 119 : CMM=CTUFI(1,1) 120 : XMAT(1)=1.D0/CMM 120 : c CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 120 : call CCOTRA(WRK52,WRK2,NCOURB,WRK53) 121 : IF(KERRE.NE.0) RETURN 122 : ENDIF 123 : XMAT(1)=YOUN 124 : PMOMM=TRAC(2*NCOURB-1) 125 : IF(PMOMM.EQ.0.D0) THEN 126 : KERRE=30 127 : RETURN 128 : ENDIF 129 : C 130 : C ON CALCULE SIG0 POUR LE MOMENT MAXI 131 : C 132 : XM0SS0=4.D0*RAYOM*RAYOM*EPAI 133 : XMT0=COS(THETA0/2.D0)-0.5D0*SIN(THETA0) 134 : VSIG0=PMOMM/XM0SS0/XMT0 135 : DO 100 I=1,NCOURB 136 : TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0 137 : 100 CONTINUE 138 : ENDIF 139 : C 140 : C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP) 141 : C 142 : SEGINI WORK 143 : DO 2 I=1,NCOURB 144 : SIG(I)=TRAC(2*I-1) 145 : XLAM(I)=TRAC(2*I) 146 : 2 CONTINUE 147 : C 148 : C ON RECUPERE LES VARIABLES INTERNES 149 : C 150 : XM0SS0=4.D0*RAYOM*RAYOM*EPAI 151 : XP0SS0=2.D0*XPI*RAYOM*EPAI 152 : XJ1C=XMAT(6) 153 : T=XMAT(7) 154 : XLAM0=VAR0(5) 155 : THETA=VAR0(3)*XPI/360.D0 156 : XJP=VAR0(4) 157 : C CORRECTION DE L INITIALISATION FAITE PAR L OPERATEUR ZERO 158 : IF (THETA.LT.THETA0) THETA=THETA0 159 : C 160 : C CALCUL DE L INCREMENT DE CONTRAINTES 161 : C 162 : nstrbi=nstrs1 163 : mfr1bi=mfr1 164 : nbgmab=nbgmat 165 : nlmatb=nelmat 165 : CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR, 166 : 1 N2EL,N2PTEL,MFR1bi,IFOU,IB,IGAU,EPAIST,NBPGAU, 167 : 2 MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC, 168 : 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 169 : nstrs1=nstrbi 170 : mfr1=mfr1bi 171 : nbgmat=nbgmab 172 : nelmat=nlmatb 173 : * 174 : IF(IRTD.NE.1) THEN 175 : KERRE=69 176 : GOTO 998 177 : ENDIF 178 : * 179 : C 180 : C ON RECUPERE LES CONTRAINTES ET L INCREMENT 181 : C 182 : XM=-SIG0(6) 183 : XP=SIG0(1) 184 : CCC POUR LE CHARGEMENT M N , ON VERIFIE QUE L ON EST BIEN DANS 185 : C LA SURFACE DE CHARGE 186 : CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM 187 : CRI=CRI+XM0SS0*SIN(THETA0)*XP 188 : IBI=0 188 : CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI) 189 : IF(IBI.EQ.1) THEN 190 : KERRE=75 191 : GO TO 998 192 : ENDIF 193 : XM0=XM0SS0*SIGMA0 194 : XP0=XP0SS0*SIGMA0 195 : F=CRIT1(XM,XP,THETA0,XM0,XP0) 196 : IF(F.GE.PRECIS) THEN 197 : KERRE=22 198 : GO TO 998 199 : ENDIF 200 : DELTAM=-DSIGT(6) 201 : DELTAP=DSIGT(1) 202 : C 203 : C ON REMPLIT POUR LE CAS ELASTIQUE 204 : C 205 : DO 10 I=1,NSTRS1 206 : SIGF(I)=SIG0(I)+DSIGT(I) 207 : DEFP(I)=0.D0 208 : DSIGT(I)=0.D0 209 : 10 CONTINUE 210 : DO 11 J=1,NVARI 211 : VARF(J)=VAR0(J) 212 : 11 CONTINUE 213 : C 214 : C ON TESTE LE CAS A TRAITER 215 : C 216 : 1 CONTINUE 217 : XM1=XM+DELTAM 218 : XP1=XP+DELTAP 219 : CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM1 220 : CRI=CRI+XM0SS0*SIN(THETA0)*XP1 220 : CALL TUFIJE(XM1,XP1,THETA0,XJE,RAYOM,EPAI,YOUN) 220 : CALL TUFIC1(XM1,XP1,THETA0,IR1,PRECIS,XM0,XP0) 221 : IF (MAPL.EQ.14) THEN 222 : C 223 : C DANS LE CAS DE LA PLASTICITE PARFAITE ON NE FAIT QUE DE LA PLASTICITE 224 : C 224 : CALL TUFIC2(XJP,XJE,THETA,IR2,PRECIS,XJ1C,T,RAYOM,THETA0) 225 : ELSE 226 : IF (MAPL.EQ.18) THEN 227 : IR2=0 228 : ENDIF 229 : ENDIF 230 : IF(IIMPI.EQ.999)THEN 231 : IF(IR1.EQ.1)WRITE(IOIMP,*)'PLASTICITE' 232 : IF(IR2.EQ.1)WRITE(IOIMP,*)'ENDOMMAGEMENT' 233 : IF((IR1.EQ.0).AND.(IR2.EQ.0))WRITE(IOIMP,*)'NI PLAST NI ENDO' 234 : ENDIF 235 : C 236 : IF((IR1.EQ.0).AND.(IR2.EQ.0)) GO TO 998 237 : IF((IR1.EQ.0).AND.(IR2.EQ.1)) GO TO 2000 238 : IF((IR1.EQ.1).AND.(IR2.EQ.0)) GO TO 3000 239 : IF((IR1.EQ.1).AND.(IR2.EQ.1)) GO TO 4000 240 : C 241 : C CAS DE LA PROPAGATION EN ELASTIQUE 242 : C 243 : 2000 CONTINUE 243 : CALL TUFIEN(XM,XP,DELTAM,DELTAP,THETA,XJP,PRECIS,THETA0,XM0, 244 : & XP0,XJ1C,T,RAYOM,EPAI,YOUN) 245 : IF(KERRE.NE.0) GO TO 998 246 : SIGF(6)=-XM 247 : SIGF(1)=XP 248 : VARF(3)=THETA*360.D0/XPI 249 : IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998 250 : GO TO 1 251 : C 252 : C CAS DE LA PLASTICITE AVEC PROPAGATION 253 : C 254 : 3000 CONTINUE 255 : C 256 : C ON CHERCHE L INTERSECTION AVEC LA SURFACE DE CHARGE 257 : C 258 : VER=F 259 : IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'VERIF AVANT APPEL A TUFICO',VER 260 : PRECUS=-PRECIS 261 : IF(VER.LE.PRECUS) THEN 261 : CALL TUFICO(XM,XP,DELTAM,DELTAP,THETA0,XM0,XP0) 262 : IF(IIMPI.EQ.999)THEN 263 : VER=F 264 : WRITE (IOIMP,*)'ON EST SUR LE CRITERE',VER 265 : ENDIF 266 : ENDIF 267 : C 268 : C ON REALISE L ECOULEMENT 269 : C 269 : CALL TUFIPL(XM,XP,DELTAM,DELTAP,THETA,XJP,DLAM1,DLAM2,EP,FIP, 270 : $ PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,XJ1C,T,THETA0,EPAI,YOUN,KERRE 271 : $ ,MAPL) 272 : IF(KERRE.NE.0) GO TO 998 273 : C 274 : IF(IIMPI.EQ.999)THEN 275 : VER=CRIT1(XM,XP,THETA0,XM0,XP0) 276 : WRITE (IOIMP,*) 'VERIF APRES ECOULEMENT',VER 277 : ENDIF 277 : CALL TUFK1A(XM,XP,YOUN,RAYOM,EPAI,THETA0,XK1,AIRE) 278 : IF (MAPL.EQ.18) THEN 279 : C 280 : CDANS LE CAS DE LA PLASTICITE AVEC ECROUISSAGE ON FAIT DE LA PROPAGATION 281 : C 281 : CALL TUFJDA(THETA,XJP,RAYOM,JDA,THETA0,XK1,YOUN,KERRE2) 282 : KERRE = KERRE2 283 : IF(KERRE.NE.0) GO TO 998 284 : ENDIF 285 : SIGF(6)=-XM 286 : SIGF(1)=XP 287 : SIGF(7)=XK1 288 : SIGF(8)=AIRE 289 : DEFP(6)=DEFP(6)-FIP 290 : DEFP(1)=DEFP(1)+EP 291 : VARF(1)=VARF(1)+DLAM1 292 : VARF(2)=VARF(2)+DLAM2 293 : VARF(3)=(THETA*360.D0)/XPI 294 : VARF(4)=XJP 295 : VARF(5)=VARF(5)+DLAM1+DLAM2 296 : C IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998 297 : C GO TO 1 298 : C 299 : C CAS DU COUPLAGE PLASTICITE PROPAGATION 300 : C 301 : 4000 GO TO 998 302 : 998 CONTINUE 303 : SEGSUP WORK 304 : RETURN 305 : END 306 : 307 : 308 : 309 : 310 : 311 : 312 : 313 : 314 : 315 : 316 : 317 : 318 : 319 : 320 :
© Cast3M 2003 - All rights reserved.
Disclaimer