1 : C TUFPLA SOURCE PV 11/03/07 21:18:40 6885 2 : SUBROUTINE TUFPLA(WRK1,WRK0,WRK2,WTRAV,MAPL,PRECIS, 3 : 1 NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB, 4 : 2 IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT, 5 : 3 NBPGAU,SECT,LHOOK,CRIGI,KERRE) 6 : * 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : C---------------------------------------------------------------------- 10 : C PLASTICITE TUYAU FISSURE 11 : C CE SOUS PROGRAMME EST APPELE PAR PLAST 12 : C 13 : C ENTREES 14 : C SIG0(NSTRS) = CONTRAINTES INITIALES 15 : C NSTRS = NOMBRE DE CONTRAINTES 16 : C DEPST(NSTRS)= INCREMENT DE CONTRAINTES TOTALES 17 : C VAR0(NVARI) = VARIABLES INTERNES DEBUT 18 : C NVARI = NOMBRE DE VARIABLES INTERNES 19 : C XMAT(NCXMAT)= COMPOSANTES DE MATERIAU 20 : C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU 21 : C XCAR(ICARA) = CARACTERISTIQUES 22 : C ICARA = NOMBRE DE CARACTERISTIQUES 23 : C MAPL = NUMERO DU MATERIAU PLASTIQUE 24 : C NPOITR = NOMBRE DE POINT SUR LA COURBE DE TRACTION 25 : C PRECIS = PRECISION DES ITERATIONS 26 : * CMATE = NOM DU MATERIAU 27 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE 28 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE 29 : * MFR = NUMERO DE LA FORMULATION 30 : * IFOU = OPTION DE CALCUL 31 : * IB = NUMERO DE L ELEMENT COURANT 32 : * IGAU = NUMERO DU POINT COURANT 33 : * EPAIST= EPAISSEUR 34 : * NBPGAU= NBRE DE POINTS DE GAUSS 35 : * MELE = NUMERO DE L ELEMENT FINI 36 : * NPINT = NBRE DE POINTS D INTEGRATION 37 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES 38 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES 39 : * SECT = SECTION 40 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE 41 : * 42 : C SORTIES 43 : C SIGF(NSTRS) = CONTRAINTES FINALES 44 : C VARF(NVARI) = VARIABLES INTERNES FINALES 45 : C DEFP(NSTRS) = DEFORMATIONS PLASTIQUES 46 : C KERRE = 0 TOUT OK 47 : C 1 SI DLAMBDA NEGATIF 48 : C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE 49 : C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG 50 : C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE 51 : C 30 LIMITE ELASTIQUE NULLE 52 : C 34 MODULE D YOUNG NUL 53 : C 75 SORTIE DE LA COURBE DE TRACTION 54 : C----------------------------------------------------------------------- 55 : -INC CCREEL 56 : *- 57 : -INC CCOPTIO 58 : -INC SMEVOLL 59 : -INC SMLREEL 60 : SEGMENT/WRK0/(XMAT(NCXMAT)*D) 61 : SEGMENT/WRK1/(DDHOOK(LHOOK,LHOOK)*D,SIG0(NSTRS)*D, 62 : . DEPST(NSTRS)*D,SIGF(NSTRS)*D,VAR0(NVARI)*D, 63 : . VARF(NVARI)*D,DEFP(NSTRS)*D,XCAR(ICARA)*D) 64 : SEGMENT/WRK2/(TRAC(LTRAC)*D) 65 : SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D) 66 : SEGMENT/WTRAV/(DDAUX(LHOOK,LHOOK)*D,VALMAT(NUMAT)*D, 67 : . VALCAR(NUCAR)*D,DSIGT(NSTRS)*D,TXR(IDIM,IDIM)*D, 68 : . DDHOMU(LHOOK,LHOOK)*D,XLOC(IDIM,IDIM)*D,XGLOB(IDIM,IDIM)*D, 69 : . D1HOOK(LHOOK,LHOOK)*D,ROTHOO(LHOOK,LHOOK)*D) 70 : DIMENSION DTUFI(2,2),CTUFI(2,2),CRIGI(12) 71 : CHARACTER*8 CMATE 72 : C 73 : KERRE=0 74 : NSTRS=SIG0(/1) 75 : NVARI=VAR0(/1) 76 : C 77 : C ON RECUPERE LES CONSTANTES 78 : C 79 : EPAI=XCAR(2) 80 : RAYOM=XCAR(1)-EPAI/2.D0 81 : THETA0=XCAR(9)*XPI/360.D0 82 : C 83 : C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP) 84 : C 85 : YOUN=XMAT(1) 86 : JDA=nint(XMAT(6)) 87 : IF(MAPL.EQ.14) THEN 88 : CCC CAS DE LA PLASTICITE PARFAITE 89 : IF(XMAT(5).EQ.XZERO) THEN 90 : KERRE=30 91 : RETURN 92 : ENDIF 93 : NCOURB=2 94 : TRAC(1)=XMAT(5) 95 : TRAC(2)=XZERO 96 : TRAC(3)=XMAT(5) 97 : TRAC(4)=1.D0 98 : ELSE 99 : IF(MAPL.EQ.18) THEN 100 : CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE 101 : C 102 : C ON CALCULE LA COMPLAISANCE CMM ET ON REMPLIT XMAT(1)=CMM POUR VERIF 103 : C PENTE A L ORIGINE DE LA COURBE (M,PHI) 104 : C 104 : CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI) 105 : CMM=CTUFI(1,1) 106 : XMAT(1)=1.D0/CMM 106 : CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 107 : IF(KERRE.NE.0) RETURN 108 : ENDIF 109 : XMAT(1)=YOUN 110 : PMOMM=TRAC(2*NCOURB-1) 111 : IF(PMOMM.EQ.0.D0) THEN 112 : KERRE=30 113 : RETURN 114 : ENDIF 115 : C 116 : C ON CALCULE SIG0 POUR LE MOMENT MAXI 117 : C 118 : XM0SS0=4.D0*RAYOM*RAYOM*EPAI 119 : XMT0=COS(THETA0/2.D0)-0.5D0*SIN(THETA0) 120 : VSIG0=PMOMM/XM0SS0/XMT0 121 : DO 100 I=1,NCOURB 122 : TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0 123 : 100 CONTINUE 124 : ENDIF 125 : C 126 : C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP) 127 : C 128 : SEGINI WORK 129 : DO 2 I=1,NCOURB 130 : SIG(I)=TRAC(2*I-1) 131 : XLAM(I)=TRAC(2*I) 132 : 2 CONTINUE 133 : C 134 : C ON RECUPERE LES VARIABLES INTERNES 135 : C 136 : XM0SS0=4.D0*RAYOM*RAYOM*EPAI 137 : XP0SS0=2.D0*XPI*RAYOM*EPAI 138 : XJ1C=XMAT(6) 139 : T=XMAT(7) 140 : XLAM0=VAR0(5) 141 : THETA=VAR0(3)*XPI/360.D0 142 : XJP=VAR0(4) 143 : C CORRECTION DE L INITIALISATION FAITE PAR L OPERATEUR ZERO 144 : IF (THETA.LT.THETA0) THETA=THETA0 145 : C 146 : C CALCUL DE L INCREMENT DE CONTRAINTES 147 : C 147 : CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR, 148 : 1 N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,NBPGAU, 149 : 2 MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC, 150 : 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 151 : * 152 : IF(IRTD.NE.1) THEN 153 : KERRE=69 154 : GOTO 998 155 : ENDIF 156 : * 157 : C 158 : C ON RECUPERE LES CONTRAINTES ET L INCREMENT 159 : C 160 : XM=-SIG0(6) 161 : XP=SIG0(1) 162 : CCC POUR LE CHARGEMENT M N , ON VERIFIE QUE L ON EST BIEN DANS 163 : C LA SURFACE DE CHARGE 164 : CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM 165 : CRI=CRI+XM0SS0*SIN(THETA0)*XP 166 : IBI=0 166 : CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI) 167 : IF(IBI.EQ.1) THEN 168 : KERRE=75 169 : GO TO 998 170 : ENDIF 171 : XM0=XM0SS0*SIGMA0 172 : XP0=XP0SS0*SIGMA0 173 : F=CRIT1(XM,XP,THETA0,XM0,XP0) 174 : IF(F.GE.PRECIS) THEN 175 : KERRE=22 176 : GO TO 998 177 : ENDIF 178 : DELTAM=-DSIGT(6) 179 : DELTAP=DSIGT(1) 180 : C 181 : C ON REMPLIT POUR LE CAS ELASTIQUE 182 : C 183 : DO 10 I=1,NSTRS 184 : SIGF(I)=SIG0(I)+DSIGT(I) 185 : DEFP(I)=0.D0 186 : DSIGT(I)=0.D0 187 : 10 CONTINUE 188 : DO 11 J=1,NVARI 189 : VARF(J)=VAR0(J) 190 : 11 CONTINUE 191 : C 192 : C ON TESTE LE CAS A TRAITER 193 : C 194 : 1 CONTINUE 195 : XM1=XM+DELTAM 196 : XP1=XP+DELTAP 197 : CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM1 198 : CRI=CRI+XM0SS0*SIN(THETA0)*XP1 198 : CALL TUFIJE(XM1,XP1,THETA0,XJE,RAYOM,EPAI,YOUN) 198 : CALL TUFIC1(XM1,XP1,THETA0,IR1,PRECIS,XM0,XP0) 199 : IF (MAPL.EQ.14) THEN 200 : C 201 : C DANS LE CAS DE LA PLASTICITE PARFAITE ON NE FAIT QUE DE LA PLASTICITE 202 : C 202 : CALL TUFIC2(XJP,XJE,THETA,IR2,PRECIS,XJ1C,T,RAYOM,THETA0) 203 : ELSE 204 : IF (MAPL.EQ.18) THEN 205 : IR2=0 206 : ENDIF 207 : ENDIF 208 : IF(IIMPI.EQ.999)THEN 209 : IF(IR1.EQ.1)WRITE(IOIMP,*)'PLASTICITE' 210 : IF(IR2.EQ.1)WRITE(IOIMP,*)'ENDOMMAGEMENT' 211 : IF((IR1.EQ.0).AND.(IR2.EQ.0))WRITE(IOIMP,*)'NI PLAST NI ENDO' 212 : ENDIF 213 : C 214 : IF((IR1.EQ.0).AND.(IR2.EQ.0)) GO TO 998 215 : IF((IR1.EQ.0).AND.(IR2.EQ.1)) GO TO 2000 216 : IF((IR1.EQ.1).AND.(IR2.EQ.0)) GO TO 3000 217 : IF((IR1.EQ.1).AND.(IR2.EQ.1)) GO TO 4000 218 : C 219 : C CAS DE LA PROPAGATION EN ELASTIQUE 220 : C 221 : 2000 CONTINUE 221 : CALL TUFIEN(XM,XP,DELTAM,DELTAP,THETA,XJP,PRECIS,THETA0,XM0, 222 : & XP0,XJ1C,T,RAYOM,EPAI,YOUN) 223 : IF(KERRE.NE.0) GO TO 998 224 : SIGF(6)=-XM 225 : SIGF(1)=XP 226 : VARF(3)=THETA*360.D0/XPI 227 : IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998 228 : GO TO 1 229 : C 230 : C CAS DE LA PLASTICITE AVEC PROPAGATION 231 : C 232 : 3000 CONTINUE 233 : C 234 : C ON CHERCHE L INTERSECTION AVEC LA SURFACE DE CHARGE 235 : C 236 : VER=F 237 : IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'VERIF AVANT APPEL A TUFICO',VER 238 : PRECUS=-PRECIS 239 : IF(VER.LE.PRECUS) THEN 239 : CALL TUFICO(XM,XP,DELTAM,DELTAP,THETA0,XM0,XP0) 240 : IF(IIMPI.EQ.999)THEN 241 : VER=F 242 : WRITE (IOIMP,*)'ON EST SUR LE CRITERE',VER 243 : ENDIF 244 : ENDIF 245 : C 246 : C ON REALISE L ECOULEMENT 247 : C 247 : CALL TUFIPL(XM,XP,DELTAM,DELTAP,THETA,XJP,DLAM1,DLAM2,EP,FIP, 248 : $ PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,XJ1C,T,THETA0,EPAI,YOUN,KERRE 249 : $ ,MAPL) 250 : IF(KERRE.NE.0) GO TO 998 251 : C 252 : IF(IIMPI.EQ.999)THEN 253 : VER=CRIT1(XM,XP,THETA0,XM0,XP0) 254 : WRITE (IOIMP,*) 'VERIF APRES ECOULEMENT',VER 255 : ENDIF 255 : CALL TUFK1A(XM,XP,YOUN,RAYOM,EPAI,THETA0,XK1,AIRE) 256 : IF (MAPL.EQ.18) THEN 257 : C 258 : CDANS LE CAS DE LA PLASTICITE AVEC ECROUISSAGE ON FAIT DE LA PROPAGATION 259 : C 259 : CALL TUFJDA(THETA,XJP,RAYOM,JDA,THETA0,XK1,YOUN,KERRE) 260 : IF(KERRE.NE.0) GO TO 998 261 : ENDIF 262 : SIGF(6)=-XM 263 : SIGF(1)=XP 264 : SIGF(7)=XK1 265 : SIGF(8)=AIRE 266 : DEFP(6)=DEFP(6)-FIP 267 : DEFP(1)=DEFP(1)+EP 268 : VARF(1)=VARF(1)+DLAM1 269 : VARF(2)=VARF(2)+DLAM2 270 : VARF(3)=(THETA*360.D0)/XPI 271 : VARF(4)=XJP 272 : VARF(5)=VARF(5)+DLAM1+DLAM2 273 : C IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998 274 : C GO TO 1 275 : C 276 : C CAS DU COUPLAGE PLASTICITE PROPAGATION 277 : C 278 : 4000 GO TO 998 279 : 998 CONTINUE 280 : SEGSUP WORK 281 : RETURN 282 : END 283 : 284 : 285 : 286 : 287 : 288 : 289 :
© Cast3M 2003 - All rights reserved.
Disclaimer