OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
mmstifs.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine mmstifs (pm, mat, hh, vol, icsig, dd, gg, dg, g33, dm, gm, dgm, iorth, sig, ir, is, it, nel, jhbe, mtn)

Function/Subroutine Documentation

◆ mmstifs()

subroutine mmstifs ( pm,
integer, dimension(*) mat,
hh,
vol,
integer icsig,
dd,
gg,
dg,
g33,
dm,
gm,
dgm,
integer iorth,
sig,
integer ir,
integer is,
integer it,
integer nel,
integer, intent(in) jhbe,
integer, intent(in) mtn )

Definition at line 38 of file mmstifs.F.

44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56#include "impl1_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER, INTENT(IN) :: MTN
61 INTEGER, INTENT(IN) :: JHBE
62 INTEGER ICSIG,IORTH,IR,IS,IT,NEL
63 INTEGER MAT(*)
64C REAL
65 my_real
66 . pm(npropm,*),hh(2,*),dd(3,3,*),gg(*),vol(*),
67 . dg(3,3,*),g33(3,3,*),dm(3,3,*),gm(3,3,*),dgm(3,3,*),
68 . sig(nel,6)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,ICS,ICT,ICR,J,K
73C REAL
74 my_real
75 . tt,tv,tt0,g(mvsiz),qh(mvsiz),ee,sfac
76C-----------------------------------------------
77 sfac=one
78 IF (ismdisp>0) sfac=em05
79 IF (iorth>0) THEN
80 IF (ikt==3) THEN
81 DO i=1,nel
82C QH(I)=GM(1,1,I)
83candr write(*,*)' QH(I)=', QH(I)!.. contains H modulus ..
84candr ... H module is wrong here, it is due to an 'unclean'
85candr ... passing it from routine 'mmats'
86candr ... setting it 'by hand' proves that everything else
87candr ... is correct
88candr QH(I)=1949.29d0 ! .. H for tension-torsion test ..
89
90c G(I) = HH(2,I)
91 ENDDO
92 DO j = 1, 3
93 DO k = 1, 3
94 DO i=1,nel
95 dgm(j,k,i)=zero
96 gm(j,k,i)=zero
97 ENDDO
98 ENDDO
99 ENDDO
100 CALL gethkt3(
101 1 1, nel, qh, ir,
102 2 is, it, mtn)
103 CALL sktvonm3(1 ,nel ,dm ,hh ,sig ,
104 . dgm ,gm ,qh ,nel )
105 ELSEIF (ikt==4) THEN
106 DO i=1,nel
107 qh(i)= hh(1,i)
108 g(i) = hh(2,i)
109 ENDDO
110 CALL sktcons2(
111 1 1, nel, dm, qh,
112 2 g, dgm, gm, ir,
113 3 is, it, nel, mtn)
114 END IF
115 DO j = 1, 3
116 DO k = j, 3
117 DO i=1,nel
118 dd(j,k,i)=dm(j,k,i)*vol(i)
119 g33(j,k,i)=gm(j,k,i)*vol(i)
120 dd(k,j,i)=dd(j,k,i)
121 g33(k,j,i)=g33(j,k,i)
122 ENDDO
123 ENDDO
124 ENDDO
125candr (DG is non-symmetric)
126 DO j = 1, 3
127 DO k = 1, 3
128 DO i=1,nel
129 dg(j,k,i)=dgm(j,k,i)*vol(i)
130 ENDDO
131 ENDDO
132 ENDDO
133
134 ELSE
135 IF (jhbe==15) THEN
136 DO i=1,nel
137 tv=hh(1,i)*vol(i)
138 gg(i)=hh(2,i)*vol(i)
139 tt0=one/(tv+two*gg(i))
140 tt=four*gg(i)*(tv+gg(i))*tt0
141 tv=two*gg(i)*tv*tt0
142 ee=gg(i)*(three*hh(1,i)+two*hh(2,i))/(hh(1,i)+hh(2,i))
143 dd(1,1,i)=tt
144 dd(2,2,i)=tt
145 dd(3,3,i)=sfac*ee
146 dd(1,2,i)=tv
147 dd(1,3,i)=zero
148 dd(2,1,i)=tv
149 dd(2,3,i)=zero
150 dd(3,1,i)=zero
151 dd(3,2,i)=zero
152 ENDDO
153 ELSEIF (jhbe==14.AND.icsig>0) THEN
154 ics=icsig/100
155 ict=mod(icsig/10,10)
156 icr=mod(icsig,10)
157 DO i=1,nel
158 tv=hh(1,i)*vol(i)
159 gg(i)=hh(2,i)*vol(i)
160 tt0=one/(tv+two*gg(i))
161 tt=four*gg(i)*(tv+gg(i))*tt0
162 tv=two*gg(i)*tv*tt0
163 ee=gg(i)*(three*hh(1,i)+two*hh(2,i))/(hh(1,i)+hh(2,i))
164 dd(1,1,i)=tt
165 dd(2,2,i)=tv
166 dd(3,3,i)=sfac*ee
167 ENDDO
168 IF (ics==1) THEN
169 DO i=1,nel
170 tt=dd(1,1,i)
171 tv=dd(2,2,i)
172 dd(1,1,i)=tt
173 dd(2,2,i)=tt
174 dd(1,2,i)=tv
175 dd(1,3,i)=zero
176 dd(2,1,i)=tv
177 dd(2,3,i)=zero
178 dd(3,1,i)=zero
179 dd(3,2,i)=zero
180 ENDDO
181 ELSEIF (ict==1) THEN
182 DO i=1,nel
183 tt=dd(1,1,i)
184 tv=dd(2,2,i)
185 dd(1,1,i)=tt
186 dd(2,2,i)=dd(3,3,i)
187 dd(3,3,i)=tt
188 dd(1,2,i)=zero
189 dd(1,3,i)=tv
190 dd(2,1,i)=zero
191 dd(2,3,i)=zero
192 dd(3,1,i)=tv
193 dd(3,2,i)=zero
194 ENDDO
195 ELSEIF (icr==1) THEN
196 DO i=1,nel
197 tt=dd(1,1,i)
198 tv=dd(2,2,i)
199 dd(1,1,i)=dd(3,3,i)
200 dd(2,2,i)=tt
201 dd(3,3,i)=tt
202 dd(1,2,i)=zero
203 dd(1,3,i)=zero
204 dd(2,1,i)=zero
205 dd(2,3,i)=tv
206 dd(3,1,i)=zero
207 dd(3,2,i)=tv
208 ENDDO
209 ENDIF
210 ELSE
211 DO i=1,nel
212 tv=hh(1,i)*vol(i)
213 gg(i)=hh(2,i)*vol(i)
214 tt=tv+two*gg(i)
215 dd(1,1,i)=tt
216 dd(2,2,i)=tt
217 dd(3,3,i)=tt
218 dd(1,2,i)=tv
219 dd(1,3,i)=tv
220 dd(2,1,i)=tv
221 dd(2,3,i)=tv
222 dd(3,1,i)=tv
223 dd(3,2,i)=tv
224 ENDDO
225 ENDIF
226 END IF !(IORTH>0) THEN
227C
228 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
gethkt3
subroutine gethkt3(jft, jlt, ht, ir, is, it, mtn)
Definition gethkt3.F:34
sktcons2
subroutine sktcons2(jft, jlt, cc, lamda, g, cg, g33, ir, is, it, nel, mtn)
Definition sktcons2.F:37
sktvonm3
subroutine sktvonm3(lft, llt, dd, hh, sig, dd1, gt, ht, nel)
Definition sktvonm3.F:30