1 : C PSTRE3 SOURCE CHAT 05/01/13 02:38:19 5004 2 : c--------------------------------------------------------------------- 3 : c 4 : SUBROUTINE PSTRE3 (SIGMA, SGPRI) 5 : c 6 : c===================================================================== 7 : c = 8 : c This routine calculates the eigen stress values of 3D = 9 : c 'sigma (6)' and puts the results in 'sgpri (3)'. = 10 : c = 11 : c Note: sigma = (Sxx, Syy, Szz, Sxy, Sxz, Syz) = 12 : c sgpri = (S11, S22, S33) = 13 : c = 14 : c===================================================================== 15 : IMPLICIT INTEGER(I-N) 16 : real*8 sigma (6), sgpri (6) 17 : c 18 : integer*4 i 19 : real*8 x (6), a (6), 20 : . oneth, t, tp, tp3, sm, xj1, xj2, xj3, r, arg 21 : c 22 : data a 23 : . / 1.0 d0, 1.0 d0, 1.0 d0, 0.0 d0, 0.0 d0, 0.0 d0 / 24 : data oneth, tp 25 : . / 0.333333333333333 d0, 6.283185307179586 d0 / 26 : c 27 : tp3 = tp * oneth 28 : c 29 : xj1 = sigma (1) + sigma (2) + sigma (3) 30 : sm = xj1 * oneth 31 : c 32 : do 10 i = 1, 6 33 : x (i) = sigma (i) - a (i) * sm 34 : 10 continue 35 : c 36 : xj2 = (x (1) **2 + x (2) **2 + x (3) **2) * 0.5 d0 + 37 : . x (4) **2 + x (5) **2 + x (6) **2 38 : c 39 : if (xj2 .gt. 0.0 d0) then 40 : r = 2.0 d0 * SQRT (xj2 * oneth) 41 : xj3 = x (1) * (x (2) * x (3) - x (6) * x (6)) - 42 : . x (4) * (x (4) * x (3) - x (5) * x (6)) + 43 : . x (5) * (x (4) * x (6) - x (2) * x (5) ) 44 : arg = -3.0 d0 * xj3 / (r * xj2) 45 : if (arg .gt. 1.0 d0) then 46 : arg = 1.0 d0 47 : else if (arg .lt. -1.0 d0) then 48 : arg = -1.0 d0 49 : end if 50 : t = asin (arg) * oneth 51 : c 52 : sgpri (1) = r * sin (t + tp3) + sm 53 : sgpri (2) = r * sin (t ) + sm 54 : sgpri (3) = r * sin (t + 2.0 d0 * tp3) + sm 55 : else 56 : sgpri (1) = sigma (1) 57 : sgpri (2) = sigma (2) 58 : sgpri (3) = sigma (3) 59 : end if 60 : c 61 : return 62 : end 63 : 64 :
© Cast3M 2003 - All rights reserved.
Disclaimer