1 : C PARTIT SOURCE CHAT 05/01/13 02:09:41 5004 2 : c--------------------------------------------------------------------- 3 : c 4 : SUBROUTINE PARTIT (NDIME, NSTR1, NTENS, NCOMP, 5 : . betam, sgeff, sgten, sgcom) 6 : c 7 : c===================================================================== 8 : c = 9 : c This subroutine determines principal stresses and directions and = 10 : c performs split of stress tensor into tensile and compressive = 11 : c contributions (eigen system). = 12 : c ------------ = 13 : c Variables: = 14 : c = 15 : c ntens no. of tension componentes = 16 : c ncomp " " compre. " = 17 : c = 18 : c betam rotation matrix = 19 : c sgeff effect. stress tensor to be splitted = 20 : c sgten tension stress tensor contribution = 21 : c sgcom compre. " " " = 22 : c = 23 : c stpri eigen stresses = 24 : c = 25 : c Author: Rui Faria Version: 93.08.25 = 26 : c -------- = 27 : c===================================================================== 28 : IMPLICIT INTEGER(I-N) 29 : integer*4 ndime, nstr1, ntens, ncomp 30 : real*8 sgeff (nstr1), sgten (nstr1), sgcom (nstr1), 31 : . betam (ndime,ndime) 32 : c 33 : integer*4 istrs 34 : real*8 eigen, stpri (3) 35 : c=====---------------------------------------------------------------- 36 : c determination of principal stresses and directions | 37 : c=====---------------------------------------------------------------- 38 : C+CCd 39 : if (nstr1 .eq. 6) then 39 : call pstres (6, sgeff, stpri) 39 : call pdirec (3, nstr1, sgeff, stpri, betam) 40 : else 40 : call pdirec (2, nstr1, sgeff, stpri, betam) 41 : end if 42 : C CCd 43 : c=====---------------------------------------------------------------- 44 : c partition of stress tensor | 45 : c=====---------------------------------------------------------------- 46 : ntens = 0 47 : ncomp = 0 48 : c 49 : do 10 istrs = 1, 3 50 : eigen = stpri (istrs) 51 : if (eigen .ge. 0.0 d0) then 52 : ntens = ntens + 1 53 : sgten (istrs) = eigen 54 : sgcom (istrs) = 0.0 d0 55 : else 56 : ncomp = ncomp + 1 57 : sgten (istrs) = 0.0 d0 58 : sgcom (istrs) = eigen 59 : end if 60 : 10 continue 61 : c 62 : return 63 : end 64 : 65 :
© Cast3M 2003 - All rights reserved.
Disclaimer