1 : C SOMDRU SOURCE CHAT 05/01/13 03:21:58 5004 2 : SUBROUTINE SOMDRU(IBOU,SI,DEPS,EPST, 3 : . EPSTAR,SN,XMAT,YUNG,XNU,PENTE,KERRE,ecou,necou) 4 : * 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL *8(A-H,O-Z) 7 : DIMENSION XMAT(*) 8 : -INC CCOPTIO 9 : * 10 : SEGMENT ECOU 11 : *** COMMON/ECOU/TEST,ALFAH, 12 : REAL*8 TEST, ALFAH, 13 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 14 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 15 : 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 16 : 2 SIPLAD(6),DSIGP0(6),TET,TETI 17 : ENDSEGMENT 18 : C COMMON/ECOU/TEST,ALFAH, 19 : C . HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 20 : C . CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 21 : C . DALPHA(6),EPSPLA(6),E(12),XINV(3), 22 : C . SIPLAD(6),DSIGP0(6),TET,TETI 23 : * 24 : SEGMENT NECOU 25 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 26 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 27 : . ITYP,JFOUR,IFLUAG, 28 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 29 : . JFLUAG,LEGAUS,LFLUAG, 30 : . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF 31 : ENDSEGMENT 32 : C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 33 : C . ITYP,JFOUR,IFLUAG, 34 : C . ICINE,ITHER,IFLUPL,ICYCL,IBI, 35 : C . JFLUAG,LEGAUS,LFLUAG, 36 : C . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF 37 : * 38 : * QUELQUES INITIALISATIONS 39 : * 40 : KERRE=0 41 : XMATE =XMAT(1) 42 : XMATM =XMAT(2) 43 : XMATKL=XMAT(3) 44 : XMATC =XMAT(4) 45 : XMATD =XMAT(5) 46 : PEPSI =SQRT(2.D0*XMATC*XMATC+XMATD*XMATD) 47 : * PENTE =XMAT(9)*PEPSI 48 : XI1LIM=SN/XMATE 49 : * 50 : * PROJECTION AU SOMMET 51 : * 52 : IF(IIMPI.EQ.15) WRITE(IOIMP,77387) 53 : 77387 FORMAT('0 SOMDRU - ON PROJETTE AU SOMMET ') 54 : IF(IIMPI.EQ.15) WRITE(IOIMP,77388) XI1LIM,PENTE 55 : 77388 FORMAT('0 SOMDRU - XI1LIM= ',1PE12.5,2X,'PENTE= ',1PE12.5/) 55 : CALL ZDANUL(SIGEL,6) 55 : CALL ZDANUL(EPSPLA,6) 56 : * 57 : * 1-ER CAS PAS D'ECROUISSAGE 58 : * 59 : IF(PENTE.NE.0.D0) GO TO 300 60 : * 61 : 400 CONTINUE 62 : IF(ITYP.NE.1.AND.ITYP.NE.5) GO TO 201 63 : DO 202 IB=1,3 64 : SIGEL(IB)=XI1LIM/3.D0 65 : 202 CONTINUE 66 : GO TO 205 67 : 201 CONTINUE 68 : SIGEL(1)=0.5D0*XI1LIM 69 : SIGEL(2)=SIGEL(1) 70 : IF(ITYP.NE.2) GO TO 204 71 : SIGEL(1)=0.5D0*SIGEL(1) 72 : SIGEL(2)=SIGEL(1) 73 : SIGEL(4)=SIGEL(1) 74 : SIGEL(5)=SIGEL(1) 75 : GO TO 205 76 : 204 IF(ITYP.LT.7) GO TO 205 77 : SIGEL(5)=0.D0 78 : SIGEL(2)=0.D0 79 : SIGEL(4)=SIGEL(1) 80 : IF(ITYP.LT.8) GO TO 205 81 : SIGEL(4)=0.D0 82 : SIGEL(1)=XI1LIM 83 : 205 CONTINUE 84 : IF(IIMPI.EQ.15) WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU) 85 : 77389 FORMAT(1X,'SOMDRU - SIGEL '/(6(1X,1PE12.5))) 86 : * 87 : * ON CALCULE ALORS DELTA SIGMA PLASTIQUE 88 : * 89 : DO 209 IB=1,IBOU 90 : DSIGP(IB)=STOT(IB)-SIGEL(IB) 91 : 209 CONTINUE 92 : * 93 : * ON CALCULE DELTA EPSILON PLASTIQUE PUIS DELTA EPSILON * 94 : * 94 : CALL EPSIG(DSIGP,EPSPLA,JFOUR,YUNG,XNU,ITYP,ORMAT,XMAT) 95 : DEPS=VONEPS(EPSPLA,ITYP,ALFAH,COVNMS) 96 : EPST=EPSTAR+DEPS 97 : IF(IIMPI.EQ.15) WRITE(IOIMP,77390) EPSTAR,DEPS,EPST 98 : 77390 FORMAT(1X,'EPSTAR=',1PE12.5,2X,'DEPS=',1PE12.5,2X,'EPST=', 99 : . 1PE12.5/) 99 : CALL CKRIT(IMAPLA,SIGEL,ITYP,XMAT,ALFAH,COVNMS,XINV,SI) 100 : RETURN 101 : * 102 : * 2-EME CAS ECROUISSAGE 103 : * 104 : 300 CONTINUE 105 : IF(ITYP.NE.1.AND.ITYP.NE.5.AND.ITYP.NE.6) THEN 106 : KERRE=51 107 : RETURN 108 : ENDIF 109 : * 110 : * CAS DES CONTRAINTES PLANES 111 : * 112 : IF(ITYP.EQ.6) THEN 113 : IF((PENTE*XMATKL.GE.0.D0).OR.(XMAT(9).EQ.0.D0)) THEN 114 : KERRE=52 115 : RETURN 116 : ENDIF 117 : DEPS= -XI1LIM/XMAT(9) 118 : EPST= EPSTAR+DEPS 119 : IF(IIMPI.EQ.15) WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU) 120 : IF(IIMPI.EQ.15) WRITE(IOIMP,77390) EPSTAR,DEPS,EPST 120 : CALL CKRIT(IMAPLA,SIGEL,ITYP,XMAT,ALFAH,COVNMS,XINV,SI) 121 : LAPOIN=1 122 : RETURN 123 : ENDIF 124 : * 125 : * CAS DU MASSIF 126 : * 127 : IF(ITYP.EQ.1.OR.ITYP.EQ.5) THEN 128 : IF(XMATE.EQ.0.D0) THEN 129 : KERRE=52 130 : RETURN 131 : ENDIF 132 : FAC1=(1.D0-2.D0*XNU)/(3.D0*XMATE*YUNG) 133 : FAC2=FAC1*XI1LIM 134 : FAC1=FAC1*XMAT(9) 135 : UNSE = 1.D0/YUNG 136 : UNSE2= UNSE*2.D0*(1.D0+XNU) 137 : W1(1)= UNSE*(STOT(1)-XNU*(STOT(2)+STOT(3)))-FAC2 138 : W1(2)= UNSE*(STOT(2)-XNU*(STOT(1)+STOT(3)))-FAC2 139 : W1(3)= UNSE*(STOT(3)-XNU*(STOT(1)+STOT(2)))-FAC2 140 : W1(4)= UNSE2*STOT(4) 141 : W1(5)= UNSE2*STOT(5) 142 : W1(6)= UNSE2*STOT(6) 143 : AA = 1.D0-2.D0*FAC1*FAC1 144 : BB = 2.D0*FAC1*(W1(1)+W1(2)+W1(3))/3.D0 145 : CC = (VONEPS(W1,ITYP,ALFAH,COVNMS))**2 146 : IF(AA.EQ.0.D0) THEN 147 : IF(BB.EQ.0.D0) THEN 148 : KERRE=53 149 : RETURN 150 : ENDIF 151 : DEPS= CC/2.D0/BB 152 : IF(DEPS.LT.0D0) THEN 153 : KERRE=53 154 : RETURN 155 : ENDIF 156 : ELSE 157 : DISCR=BB**2+AA*CC 158 : IF(DISCR.LT.0D0) THEN 159 : KERRE=53 160 : RETURN 161 : ENDIF 162 : DISCR=SQRT(DISCR) 163 : DEPS1 = (-BB+DISCR)/AA 164 : DEPS2 = (-BB-DISCR)/AA 165 : DEPS=MAX(DEPS1,DEPS2) 166 : IF(DEPS.LT.0D0) THEN 167 : KERRE=53 168 : RETURN 169 : ENDIF 170 : ENDIF 171 : SNN = XI1LIM+XMAT(9)*DEPS 172 : * AM 24/5/93 TEST SUR SN 173 : IF(SNN .LT. 0.D0) THEN 174 : SNN=0.D0 175 : DEPS= -XI1LIM/XMAT(9) 176 : ENDIF 177 : DO 302 IB=1,3 178 : SIGEL(IB)=SNN/3.D0 179 : 302 CONTINUE 180 : EPST=EPSTAR+DEPS 181 : IF(IIMPI.EQ.15) WRITE(IOIMP,77389) (SIGEL(I),I=1,IBOU) 182 : IF(IIMPI.EQ.15) WRITE(IOIMP,77390) EPSTAR,DEPS,EPST 182 : CALL CKRIT(IMAPLA,SIGEL,ITYP,XMAT,ALFAH,COVNMS,XINV,SI) 183 : RETURN 184 : ENDIF 185 : END 186 : 187 : 188 :
© Cast3M 2003 - All rights reserved.
Disclaimer