1 : C CHAFLU SOURCE CHAT 05/01/12 21:54:10 5004 2 : SUBROUTINE CHAFLU(YUNG,XNU,IA,EI,SSTAR, 3 : 1 XMAT,ALPHA1,IBOU,SI,DEPS,EPST,EPSTAR,AMTRI, 4 : 2 ALPHA2,DPSM1,DPSM2,KERRE,NUMCHA,ecou,necou) 5 : C 6 : C INTEGRATION MODELE DE CHABOCHE EN FLUAGE 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL *8(A-H,O-Z) 10 : DIMENSION XMAT(*),EI(*),ALPHA1(*),ALPHA2(*) 11 : DIMENSION AMTRI(18,7),DELT(6) 12 : C 13 : * Commun ECOU: sert de fourre-tout pour les tableaux 14 : * 15 : SEGMENT ECOU 16 : *** COMMON/ECOU/TEST,ALFAH, 17 : REAL*8 TEST, ALFAH, 18 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 19 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 20 : 1 DALPHA(6),DSIGO(6),E(12),XINV(3), 21 : 2 SIPLAD(6),DSIGP0(6),TET,TETI 22 : ENDSEGMENT 23 : 24 : C COMMON/ECOU/TEST,ALFAH, 25 : C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 26 : C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 27 : C 1 DALPHA(6),DSIGO(6),E(12),XINV(3), 28 : C 2 SIPLAD(6),DSIGP0(6),TET,TETI 29 : C 30 : 31 : * Commun NECOU utilisé dans ECOINC 32 : * 33 : SEGMENT NECOU 34 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 35 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 36 : . ITYP,IFOUR,IFLUAG, 37 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 38 : . JFLUAG,KFLUAG,LFLUAG, 39 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 40 : ENDSEGMENT 41 : C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 42 : C . ITYP,IFOUR,IFLUAG, 43 : C . ICINE,ITHER,IFLUPL,ICYCL,IBI, 44 : C . JFLUAG,KFLUAG,LFLUAG, 45 : C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 46 : C 47 : C JFLUAG = 1 ON FLUE AVEC SIGMA ET ON RECUPERE SIGMA EN ENTREE 48 : C JFLUAG = 2 ON FLUE AVEC (SIG-X) ET ON RECUPERE (SIG-X) EN ENTREE 49 : C LFLUAG = 0 ON ECROUIT EN CAS DE FLUAGE 50 : C LFLUAG = 1 ON N'ECROUIT PAS EN CAS DE FLUAGE 51 : C 52 : IFLU=0 53 : IF(JFLUAG.GT.1.AND.LFLUAG.EQ.0) IFLU=1 54 : C 55 : A2=0. 56 : C2=0. 57 : B=0. 58 : PHI=1.D00 59 : ICOD=0 59 : CALL CHALIM(EPSTAR,R,XMAT,TET,ICOD,A1,C1,A2,C2,R0,RM,B, 60 : . PHI,PSI,OME,ICENT2,IDIAM,NUMCHA) 61 : ELT=YUNG/(1.+XNU) 62 : IF(ITHER.NE.0) ELT=ELT*EI(IA)/YUNG 63 : G=ELT*0.5 64 : SAC1=A1*C1*PHI 65 : AC1=SAC1*0.66666667 66 : SAC2=A2*C2*PHI 67 : AC2=SAC2*0.66666667 68 : SAC12=SAC1+SAC2 69 : AC12=AC1+AC2 70 : GO TO (101,102,103,104,105,103,107,104,109,999,999,999, 71 : . 103,101),ITYP 72 : 101 NPLEIN=3 73 : IBO=1 74 : E(1)=ELT+AC12*IFLU 75 : E(2)=-0.5*E(1) 76 : E(3)=1.5*E(1) 77 : E(4)=-AC1 78 : E(5)=0.5*AC1 79 : E(6)=-1.5*AC1 80 : IF(ICENT2.EQ.0) GO TO 200 81 : E(7)=-AC2 82 : E(8)=0.5*AC2 83 : E(9)=-1.5*AC2 84 : GO TO 200 85 : 102 IBO=2 86 : GO TO 121 87 : 103 IBO=1 88 : 121 NPLEIN=2 89 : E(1)=G*(2.-XNU)/(1.-XNU)+SAC12*IFLU 90 : E(2)=G*(2.*XNU-1.)/(1.-XNU) 91 : E(3)=1.5*(ELT+AC12*IFLU) 92 : E(4)=-SAC1 93 : E(5)=0. 94 : E(6)=-SAC1 95 : IF(ICENT2.EQ.0) GO TO 200 96 : E(7)=-SAC2 97 : E(8)=0. 98 : E(9)=-SAC2 99 : GO TO 200 100 : 104 IBO=1 101 : GO TO 125 102 : 107 IBO=2 103 : 125 DUM=YUNG 104 : NPLEIN=1 105 : IF(ITHER.NE.0) DUM=DUM*EI(IA)/YUNG 106 : DUM=DUM+SAC12*IFLU 107 : E(1)=DUM 108 : E(4)=-SAC1 109 : IF(ICENT2.NE.0) E(7)=-SAC2 110 : GO TO 200 111 : 105 CONTINUE 112 : 109 CONTINUE 113 : 200 IBOU1=IBOU+1 114 : TAUX=0. 115 : TIME=TEMPS-HPAS 116 : ICLFLU=0 117 : IF(IT.NE.1) GO TO 201 118 : C 119 : C MODIFS POUR LA 1-ERE ITERATION 120 : C ECOULEMENT SELON SIGMA 121 : C 122 : S0=VONMIS(SIGEL,ITYP,ALFAH,COVNMS) 122 : CALL CRPLAW(VI0,EPSTAR,S0,TET,TIME,HPAS,ICLFLU,NCOURB) 123 : DPSM1=VI0 124 : EPST=EPSTAR+HPAS*VI0 124 : CALL CRPLAW(VIF,EPST,SSTAR,TET,TEMPS,HPAS,ICLFLU,NCOURB) 125 : DPSM2=SSTAR 126 : SF=SSTAR 127 : DEPS=(VI0+VIF)*0.5D0*HPAS 128 : EPST=EPSTAR+DEPS 129 : C 130 : C TEST POUR LES CAS DE FLUAGE A SIGMA NON CTE ET AVEC SEUIL 131 : C 132 : IF(DEPS.EQ.0.) GO TO 1380 133 : DEPSUR=0. 134 : IF(SF.NE.0.) DEPSUR=DEPS/SF 134 : CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO) 135 : IF(IFLU.EQ.0) GO TO 1531 135 : CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO) 135 : IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU, 136 : . NPLEIN,E(7),DEPSUR,IBO) 137 : DO 1334 IB=1,IBOU 138 : AMTRI(IB,7)=0.D0 139 : IB1=IB+IBOU 140 : IF(ICENT2.NE.0) GO TO 1335 141 : AMTRI(IB1,7)=ALPHA1(IB) 142 : GO TO 1334 143 : 1335 AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB) 144 : AMTRI(IB1+IBOU,7)=ALPHA2(IB) 145 : 1334 CONTINUE 145 : CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2, 146 : . C1,C2,DEPS,IBO,IFLU,1,LFLUAG,KERRE) 147 : IF(KERRE.NE.0) RETURN 148 : DO 1532 I=1,IBOU 149 : DSIGP(I)=-AMTRI(I,7) 150 : DO 1533 J=1,IBOU 151 : 1533 DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J) 152 : 1532 STOT(I)=SIGEL(I)+DSIGP(I) 153 : GO TO 222 154 : 1531 DO 304 I=1,IBOU 155 : DSIGP(I)=0. 156 : DO 305 J=1,IBOU 157 : 305 DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J) 158 : 304 STOT(I)=SIGEL(I)+DSIGP(I) 159 : GO TO 221 160 : 201 CONTINUE 161 : VI0=DPSM1 162 : SF=DPSM2 163 : EPST=EPSTAR+HPAS*VI0 163 : CALL CRPLAW(VIF,EPST,SF,TET,TEMPS,HPAS,ICLFLU,NCOURB) 164 : DEPS=(VI0+VIF)*0.5*HPAS 165 : EPST=EPSTAR+DEPS 166 : 1380 CONTINUE 167 : DEPSUR=0. 168 : IF(SF.NE.0.) DEPSUR=DEPS/SF 168 : 222 CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO) 169 : 221 IF(LFLUAG.EQ.1) GO TO 1240 169 : CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO) 169 : IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU, 170 : . NPLEIN,E(7),DEPSUR,IBO) 171 : 1240 DO 202 I=1,IBOU 172 : 202 AMTRI(I,I)=AMTRI(I,I)+1. 173 : C 174 : C SECOND MEMBRE 175 : C 176 : DO 134 IB=1,IBOU 177 : AMTRI(IB,7)=STOT(IB) 178 : IF(LFLUAG.EQ.1) GO TO 134 179 : IB1=IB+IBOU 180 : IF(ICENT2.NE.0) GO TO 135 181 : AMTRI(IB1,7)=ALPHA1(IB) 182 : GO TO 134 183 : 135 AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB) 184 : AMTRI(IB1+IBOU,7)=ALPHA2(IB) 185 : 134 CONTINUE 185 : CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2,C1,C2, 186 : . DEPS,IBO,IFLU,0,LFLUAG,KERRE) 187 : IF(KERRE.NE.0) RETURN 188 : 300 SI=VONMIS(AMTRI(1,7),ITYP,ALFAH,COVNMS) 189 : DPSM2=SI 190 : DO 301 I=1,IBOU 191 : SIGEL(I)=AMTRI(I,7) 192 : IF(LFLUAG.EQ.1) GO TO 301 193 : DALPHA(I)=AMTRI(IBOU+I,7)-ALPHA1(I) 194 : IF(ICENT2.EQ.0) GO TO 301 195 : DALPHA(I)=DALPHA(I)+AMTRI(IBOU+IBOU+I,7) 196 : 301 CONTINUE 197 : C 198 : C LES DEUX CENTRES SONT CUMULES DANS ALPHA1 199 : C 200 : IF(LFLUAG.EQ.1) RETURN 201 : C 202 : C MISE A JOUR DES CENTRES DES SPHERES 203 : C 204 : DO 303 I=1,IBOU 205 : ALPHA1(I)=AMTRI(IBOU+I,7) 206 : IF(ICENT2.EQ.0) GO TO 303 207 : ALPHA1(I)=ALPHA1(I)+AMTRI(IBOU+IBOU+I,7) 208 : ALPHA2(I)=AMTRI(IBOU+IBOU+I,7) 209 : 303 CONTINUE 210 : RETURN 211 : 999 WRITE(6,7999) 212 : 7999 FORMAT('0 CHAFLU - CAS NON IMPLEMENTE ' /) 213 : RETURN 214 : END 215 : 216 : 217 : 218 : 219 : 220 :
© Cast3M 2003 - All rights reserved.
Disclaimer