OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s6cforc3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| s6cforc3 ../engine/source/elements/thickshell/solide6c/s6cforc3.F
25!||--- called by ------------------------------------------------------
26!|| forint ../engine/source/elements/forint.F
27!||--- calls -----------------------------------------------------
28!|| csmall3 ../engine/source/elements/solid/solide/csmall3.F
29!|| mmain ../engine/source/materials/mat_share/mmain.F90
30!|| s6cbilan ../engine/source/elements/thickshell/solide6c/s6cbilan.F
31!|| s6cdefc3 ../engine/source/elements/thickshell/solide6c/s6cdefo3.F
32!|| s6cderi3 ../engine/source/elements/thickshell/solide6c/s6cderi3.F
33!|| s6cfint3 ../engine/source/elements/thickshell/solide6c/s6cfint3.F
34!|| s6cfint_reg ../engine/source/elements/thickshell/solide6c/s6cfint_reg.F
35!|| s6chour3 ../engine/source/elements/thickshell/solide6c/s6chourg3.F
36!|| s6chour_ctl ../engine/source/elements/thickshell/solide6c/s6chour_ctl.F90
37!|| s6ctherm ../engine/source/elements/thickshell/solide6c/s6ctherm.F
38!|| s6cumu3 ../engine/source/elements/thickshell/solide6c/s6cumu3.F
39!|| s6cumu3p ../engine/source/elements/thickshell/solide6c/s6cumu3p.F
40!|| s6czero3 ../engine/source/elements/thickshell/solide6c/s6czero3.F
41!|| s6fillopt ../engine/source/elements/thickshell/solide6c/s6fillopt.F
42!|| s6for_distor ../engine/source/elements/thickshell/solide6c/s6for_distor.F90
43!|| s6get_xv ../engine/source/elements/thickshell/solide6c/s6get_xv.F90
44!|| s6proj3 ../engine/source/elements/thickshell/solide6c/s6proj3.F
45!|| s6rcoor3 ../engine/source/elements/thickshell/solide6c/s6rcoor3.F
46!|| s6sav3 ../engine/source/elements/thickshell/solide6c/s6sav3.F
47!|| s8csigp3 ../engine/source/elements/thickshell/solide8c/s8csigp3.F
48!|| scdefo3 ../engine/source/elements/thickshell/solidec/scdefo3.F
49!|| scordef3 ../engine/source/elements/thickshell/solidec/scordef3.F
50!|| scroto_sig ../engine/source/elements/thickshell/solidec/scroto_sig.F
51!|| scumualpha6 ../engine/source/elements/thickshell/solidec/scumualpha6.F
52!|| sdistor_ini ../engine/source/elements/solid/solide/sdistror_ini.F90
53!|| sdlen3 ../engine/source/elements/solid/solide/sdlen3.F
54!|| sdlensh3n ../engine/source/elements/thickshell/solidec/sdlensh3n.f
55!|| sdlensh3n2 ../engine/source/elements/thickshell/solide6c/sdlensh3n2.f
56!|| sgetdir3 ../engine/source/elements/thickshell/solidec/sgetdir3.F
57!|| sgparav3 ../engine/source/elements/solid/solide/sgparav3.f
58!|| smallb3 ../engine/source/elements/solid/solide/smallb3.F
59!|| srho3 ../engine/source/elements/solid/solide/srho3.F
60!|| sstra3 ../engine/source/elements/solid/solide/sstra3.F
61!|| tshgeodel3 ../engine/source/elements/thickshell/solidec/tshgeodel3.F
62!|| vrrota3 ../engine/source/elements/thickshell/solide6c/vrrota3.F
63!||--- uses -----------------------------------------------------
64!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
65!|| dt_mod ../engine/source/modules/dt_mod.F
66!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
67!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
68!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
69!|| mmain_mod ../engine/source/materials/mat_share/mmain.F90
70!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
71!|| output_mod ../common_source/modules/output/output_mod.f90
72!|| s6chour_ctl_mod ../engine/source/elements/thickshell/solide6c/s6chour_ctl.F90
73!|| s6for_distor_mod ../engine/source/elements/thickshell/solide6c/s6for_distor.F90
74!|| s6get_xv_mod ../engine/source/elements/thickshell/solide6c/s6get_xv.F90
75!|| sdistor_ini_mod ../engine/source/elements/solid/solide/sdistror_ini.f90
76!|| sensor_mod ../common_source/modules/sensor_mod.F90
77!|| table_mod ../engine/share/modules/table_mod.F
78!|| timer_mod ../engine/source/system/timer_mod.F90
79!||====================================================================
80 SUBROUTINE s6cforc3(TIMERS, OUTPUT, ELBUF_TAB,NG ,
81 1 PM ,GEO ,IXS ,X ,
82 2 A ,V ,MS ,W ,FLUX ,
83 3 FLU1 ,VEUL ,FV ,ALE_CONNECT ,IPARG ,
84 4 TF ,NPF ,BUFMAT ,PARTSAV,
85 5 DT2T ,NELTST ,ITYPTST ,STIFN ,FSKY ,
86 6 IADS ,OFFSET ,EANI ,IPARTS ,
87 7 F11 ,F21 ,F31 ,F12 ,F22 ,
88 8 F32 ,F13 ,F23 ,F33 ,F14 ,
89 9 F24 ,F34 ,F15 ,F25 ,F35 ,
90 A F16 ,F26 ,F36 ,NEL ,
91 B ICP ,ICSIG ,NLOC_DMG,
92 C IPM ,ISTRAIN ,IGEO ,GRESAV ,GRTH ,
93 D IGRTH ,TABLE ,MSSA ,DMELS ,VOLN ,
94 E ITASK ,IOUTPRT ,MAT_ELEM,H3D_STRAIN ,
95 F TEMP ,FTHE ,FTHESKY ,CONDN ,CONDNSKY,
96 G IEXPAN ,IFTHE ,ICONDN ,DT ,SNPC,STF,
97 H SBUFMAT ,SVIS ,NSVOIS ,IDTMINS,IRESP,
98 I IDEL7NG ,IDEL7NOK,MAXFUNC, IMON_MAT, USERL_AVAIL,
99 J GLOB_THERM,XDP,SENSORS )
100C-----------------------------------------------
101C M o d u l e s
102C-----------------------------------------------
103 USE timer_mod
104 USE output_mod, only : output_
105 USE mmain_mod
106 USE table_mod
107 USE mat_elem_mod
110 USE dt_mod
111 USE elbufdef_mod
112 USE sdistor_ini_mod, ONLY : sdistor_ini
113 USE s6get_xv_mod, ONLY : s6get_xv
114 USE s6for_distor_mod,ONLY : s6for_distor
115 USE s6chour_ctl_mod ,ONLY : s6chour_ctl
116 use glob_therm_mod
117 USE sensor_mod
118C-----------------------------------------------
119C I m p l i c i t T y p e s
120C-----------------------------------------------
121#include "implicit_f.inc"
122C-----------------------------------------------
123C G l o b a l P a r a m e t e r s
124C-----------------------------------------------
125#include "mvsiz_p.inc"
126C-----------------------------------------------
127C C o m m o n B l o c k s
128C-----------------------------------------------
129#include "com01_c.inc"
130#include "com08_c.inc"
131#include "vect01_c.inc"
132#include "parit_c.inc"
133#include "param_c.inc"
134#include "com04_c.inc"
135#include "com06_c.inc"
136#include "scr18_c.inc"
137#include "impl1_c.inc"
138C-----------------------------------------------
139C D u m m y A r g u m e n t s
140C-----------------------------------------------
141 TYPE(timer_), INTENT(inout) :: TIMERS
142 TYPE(OUTPUT_), INTENT(inout) :: OUTPUT
143 INTEGER,INTENT(IN):: SNPC
144 INTEGER,INTENT(IN):: STF
145 INTEGER, INTENT(IN) :: SBUFMAT
146 INTEGER, INTENT(IN) :: NSVOIS
147 INTEGER, INTENT(IN) :: IDTMINS
148 INTEGER ,INTENT(IN) :: IRESP
149 INTEGER ,INTENT(IN) :: IDEL7NG
150 INTEGER ,INTENT(INOUT) :: IDEL7NOK
151 INTEGER ,INTENT(IN) :: MAXFUNC
152 INTEGER, INTENT(IN) :: USERL_AVAIL
153 INTEGER, INTENT(IN) :: IMON_MAT
154 INTEGER IXS(NIXS,*),IPARG(NPARG,NGROUP),NPF(*),IADS(8,*),GRTH(*),
155 . IPARTS(*),IPM(NPROPMI,*),IGEO(NPROPGI,*),IGRTH(*), ITASK,IOUTPRT
156 INTEGER NELTST,ITYPTST,OFFSET,NG,NEL,ICP,ICSIG,ISTRAIN,H3D_STRAIN
157 INTEGER, INTENT(IN) :: IEXPAN,IFTHE,ICONDN
158 my_real
159 . DT2T
160 my_real
161 . pm(npropm,*), x(*), a(*), v(*), ms(*), w(*),
162 . flux(6,*),geo(npropg,*),
163 . flu1(*), veul(*), fv(*), tf(*), bufmat(*),
164 . partsav(*),stifn(*), fsky(*),eani(*),
165 . f11(mvsiz),f21(mvsiz),f31(mvsiz),
166 . f12(mvsiz),f22(mvsiz),f32(mvsiz),
167 . f13(mvsiz),f23(mvsiz),f33(mvsiz),
168 . f14(mvsiz),f24(mvsiz),f34(mvsiz),
169 . f15(mvsiz),f25(mvsiz),f35(mvsiz),
170 . f16(mvsiz),f26(mvsiz),f36(mvsiz),gresav(*),
171 . mssa(*), dmels(*), voln(mvsiz)
172 my_real, INTENT(INOUT) :: temp(numnod),fthe(ifthe),fthesky(lsky),
173 . condn(icondn),condnsky(lsky)
174 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
175 DOUBLE PRECISION, DIMENSION(3,NUMNOD), INTENT(IN ) :: XDP
176 TYPE (TTABLE) TABLE(*)
177 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
178 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
179 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
180 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
181 TYPE(DT_) , INTENT(INOUT) :: DT
182 type (glob_therm_) ,intent(inout) :: glob_therm
183 type (sensors_),INTENT(INOUT) :: SENSORS
184C-----------------------------------------------
185C L o c a l V a r i a b l e s
186C-----------------------------------------------
187 INTEGER I,J,LCO,NF1,IFLAG,NUVAR,CURRENT_LAYER,IMAT,
188 . ILAY,NLAY,IR,IS,IT,IP,IBID,MX,L_PLA,L_EPSD
189 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ),IBIDON(1)
190c Variables utilisees dans les routines solides uniquement (en arguments).
191 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
192 . NC5(MVSIZ), NC6(MVSIZ), NC7(MVSIZ), NC8(MVSIZ)
193C----------
194 my_real
195 . c1,dti, mbid(1)
196 my_real
197 . vd2(mvsiz) , dvol(mvsiz),deltax(mvsiz),
198 . vis(mvsiz) , qvis(mvsiz), cxx(mvsiz) ,
199 . s1(mvsiz) , s2(mvsiz) , s3(mvsiz) ,
200 . s4(mvsiz) , s5(mvsiz) , s6(mvsiz) ,
201 . dxx(mvsiz) , dyy(mvsiz) , dzz(mvsiz) ,
202 . d4(mvsiz) , d5(mvsiz) , d6(mvsiz) ,
203 . jac1(mvsiz), jac2(mvsiz), jac3(mvsiz),
204 . jac4(mvsiz), jac5(mvsiz), jac6(mvsiz),
205 . vdx(mvsiz) , vdy(mvsiz) , vdz(mvsiz),ssp_eq(mvsiz),aire(mvsiz)
206C-----
207 my_real
208 . sti(mvsiz),wxx(mvsiz),wyy(mvsiz),wzz(mvsiz),conde(mvsiz)
209C
210 my_real
211 . muvoid(mvsiz)
212 my_real
213 . off(mvsiz) , rhoo(mvsiz), offg(mvsiz) ,
214 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
215 . x5(mvsiz), x6(mvsiz),
216 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
217 . y5(mvsiz), y6(mvsiz),
218 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
219 . z5(mvsiz), z6(mvsiz),
220 . vx1(mvsiz),vx2(mvsiz),vx3(mvsiz),vx4(mvsiz),
221 . vx5(mvsiz),vx6(mvsiz),
222 . vy1(mvsiz),vy2(mvsiz),vy3(mvsiz),vy4(mvsiz),
223 . vy5(mvsiz),vy6(mvsiz),
224 . vz1(mvsiz),vz2(mvsiz),vz3(mvsiz),vz4(mvsiz),
225 . vz5(mvsiz),vz6(mvsiz),
226 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
227 . px5(mvsiz),px6(mvsiz),
228 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
229 . py5(mvsiz),py6(mvsiz),
230 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
231 . pz5(mvsiz),pz6(mvsiz),
232 . px1h(mvsiz),px2h(mvsiz),px3h(mvsiz),
233 . py1h(mvsiz),py2h(mvsiz),py3h(mvsiz),
234 . pz1h(mvsiz),pz2h(mvsiz),pz3h(mvsiz),
235 . vgxa(mvsiz),vgya(mvsiz),vgza(mvsiz), vga2(mvsiz),
236 . xgxa(mvsiz),xgya(mvsiz),xgza(mvsiz),
237 . xgxya(mvsiz),xgyza(mvsiz),xgzxa(mvsiz),
238 . xgxa2(mvsiz),xgya2(mvsiz),xgza2(mvsiz)
239 my_real
240 . dxy(mvsiz),dyx(mvsiz),
241 . dyz(mvsiz),dzy(mvsiz),
242 . dzx(mvsiz),dxz(mvsiz),divde(mvsiz)
243 my_real
244 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
245 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
246 . r31(mvsiz),r32(mvsiz),r33(mvsiz),gama(mvsiz,6)
247C 12
248 my_real
249 . sigym(mvsiz),g(mvsiz),nu(mvsiz),volg(mvsiz),sigy(mvsiz),
250 . b1122(mvsiz),b1221(mvsiz),b2212(mvsiz),b1121(mvsiz),
251 . b1122h(mvsiz),b1221h(mvsiz),b2212h(mvsiz),b1121h(mvsiz),
252 . b1x(mvsiz,2),b1y(mvsiz,2),b2x(mvsiz,2),b2y(mvsiz,2),
253 . b1xh(mvsiz,2),b1yh(mvsiz,2),b2xh(mvsiz,2),b2yh(mvsiz,2),
254 . dcxx(mvsiz),dcxy(mvsiz),dcxz(mvsiz),dcyx(mvsiz),dcyy(mvsiz),
255 . dcyz(mvsiz),dczx(mvsiz),dczy(mvsiz),dczz(mvsiz),dc4(mvsiz),
256 . dc5(mvsiz),dc6(mvsiz),vzl(mvsiz),jaci33(mvsiz),
257 . dhxx(mvsiz),dhxy(mvsiz),dhyx(mvsiz),dhyy(mvsiz),dhyz(mvsiz),
258 . dhzx(mvsiz),dhzy(mvsiz),dhzz(mvsiz),dh4(mvsiz),dhxz(mvsiz),
259 . dh5(mvsiz),dh6(mvsiz),eintm(mvsiz),ddhv(mvsiz),dd(mvsiz,6),
260 . sigzm(mvsiz),volm(mvsiz),usb(mvsiz),et(mvsiz),
261 . r1_free(mvsiz),r3_free(mvsiz),r4_free(mvsiz),
262 . stin(mvsiz),bid(mvsiz),dsv(mvsiz),alpha_e(mvsiz),llsh(mvsiz)
263C
264 INTEGER PID,MTN0,IPTHK,IPPOS,IPMAT,NLYMAX,MID,IPANG,IOFFS
265 INTEGER MXT0(MVSIZ),NN_DEL,IPRES,ISCTL,ISTAB(MVSIZ)
266 my_real
267 . dir(mvsiz,2),sign(nel,6),shf(mvsiz),zt,wt,offs(mvsiz),
268 . rx(mvsiz), ry(mvsiz), rz(mvsiz),nu1(mvsiz),fac(mvsiz),
269 . sx(mvsiz), sy(mvsiz), sz(mvsiz),
270 . tx(mvsiz), ty(mvsiz), tz(mvsiz),e0(mvsiz),
271 . n1x(mvsiz), n2x(mvsiz), n3x(mvsiz),
272 . n1y(mvsiz), n2y(mvsiz), n3y(mvsiz),
273 . n1z(mvsiz), n2z(mvsiz), n3z(mvsiz),
274 . n4x(mvsiz), n5x(mvsiz), n6x(mvsiz),
275 . n4y(mvsiz), n5y(mvsiz), n6y(mvsiz),
276 . n4z(mvsiz), n5z(mvsiz), n6z(mvsiz),amu(mvsiz),area(mvsiz)
277 my_real them(mvsiz,6),tempel(mvsiz),die(mvsiz),conden(mvsiz)
278 my_real, dimension(mvsiz) :: fheat
279 DOUBLE PRECISION
280 . VOLDP(MVSIZ),FACDP
281 INTEGER INLOC,L_NLOC,IPOS(6),INOD(6)
282 iNTEGER SZ_R1_FREE,SZ_IX
283 my_real, DIMENSION(:,:), ALLOCATABLE :: var_reg
284 my_real, DIMENSION(:), POINTER :: dnl
285 my_real :: sti_c(mvsiz),ll(mvsiz),fld(mvsiz),
286 . cns2,fqmax,dn
287C-----
288 TYPE(g_bufel_) ,POINTER :: GBUF
289 TYPE(L_BUFEL_) ,POINTER :: LBUF
290C-----------------------------------------------
291 my_real
292 . W_GAUSS(9,9),A_GAUSS(9,9)
293 DATA W_GAUSS /
294 1 2. ,0. ,0. ,
295 1 0. ,0. ,0. ,
296 1 0. ,0. ,0. ,
297 2 1. ,1. ,0. ,
298 2 0. ,0. ,0. ,
299 2 0. ,0. ,0. ,
300 3 0.555555555555556,0.888888888888889,0.555555555555556,
301 3 0. ,0. ,0. ,
302 3 0. ,0. ,0. ,
303 4 0.347854845137454,0.652145154862546,0.652145154862546,
304 4 0.347854845137454,0. ,0. ,
305 4 0. ,0. ,0. ,
306 5 0.236926885056189,0.478628670499366,0.568888888888889,
307 5 0.478628670499366,0.236926885056189,0. ,
308 5 0. ,0. ,0. ,
309 6 0.171324492379170,0.360761573048139,0.467913934572691,
310 6 0.467913934572691,0.360761573048139,0.171324492379170,
311 6 0. ,0. ,0. ,
312 7 0.129484966168870,0.279705391489277,0.381830050505119,
313 7 0.417959183673469,0.381830050505119,0.279705391489277,
314 7 0.129484966168870,0. ,0. ,
315 8 0.101228536290376,0.222381034453374,0.313706645877887,
316 8 0.362683783378362,0.362683783378362,0.313706645877887,
317 8 0.222381034453374,0.101228536290376,0. ,
318 9 0.081274388361574,0.180648160694857,0.260610696402935,
319 9 0.312347077040003,0.330239355001260,0.312347077040003,
320 9 0.260610696402935,0.180648160694857,0.081274388361574/
321 DATA a_gauss /
322 1 0. ,0. ,0. ,
323 1 0. ,0. ,0. ,
324 1 0. ,0. ,0. ,
325 2 -.577350269189626,0.577350269189626,0. ,
326 2 0. ,0. ,0. ,
327 2 0. ,0. ,0. ,
328 3 -.774596669241483,0. ,0.774596669241483,
329 3 0. ,0. ,0. ,
330 3 0. ,0. ,0. ,
331 4 -.861136311594053,-.339981043584856,0.339981043584856,
332 4 0.861136311594053,0. ,0. ,
333 4 0. ,0. ,0. ,
334 5 -.906179845938664,-.538469310105683,0. ,
335 5 0.538469310105683,0.906179845938664,0. ,
336 5 0. ,0. ,0. ,
337 6 -.932469514203152,-.661209386466265,-.238619186083197,
338 6 0.238619186083197,0.661209386466265,0.932469514203152,
339 6 0. ,0. ,0. ,
340 7 -.949107912342759,-.741531185599394,-.405845151377397,
341 7 0. ,0.405845151377397,0.741531185599394,
342 7 0.949107912342759,0. ,0. ,
343 8 -.960289856497536,-.796666477413627,-.525532409916329,
344 8 -.183434642495650,0.183434642495650,0.525532409916329,
345 8 0.796666477413627,0.960289856497536,0. ,
346 9 -.968160239507626,-.836031107326636,-.613371432700590,
347 9 -.324253423403809,0. ,0.324253423403809,
348 9 0.613371432700590,0.836031107326636,0.968160239507626/
349C-----------------------------------------------
350C S o u r c e L i n e s
351C=======================================================================
352 mtn0 = 0
353 nlymax= 0
354 ipang = 0
355 ipthk = 0
356 ippos = 0
357 ipmat = 0
358
359 gbuf => elbuf_tab(ng)%GBUF
360 nlay = elbuf_tab(ng)%NLAY
361 ir = 1
362 is = 1
363 it = 1
364 inloc = iparg(78,ng)
365 ALLOCATE(var_reg(nel,nlay))
366 sz_r1_free=mvsiz
367 sz_ix=numelq+numels+nsvois
368C-----------
369 ibid = 0
370 ibidon(1) = 0
371 IF (igtyp /= 22) THEN
372 isorthg = 0
373 END IF
374C-----------
375 nf1=nft+1
376C--------------------------
377C-----------
378 IF (isorth > 0) THEN
379 CALL sgparav3(
380 1 6, x, ixs(1,nf1),rx,
381 2 ry, rz, sx, sy,
382 3 sz, tx, ty, tz,
383 4 nel)
384 ENDIF
385C-----------------------------------------------------------
386C Gather nodal variables and compute intinsic rotations
387C-----------------------------------------------------------
388 CALL s6rcoor3(x,ixs(1,nf1),v,w,gbuf%GAMA,gama,
389 . x1, x2, x3, x4, x5, x6,
390 . y1, y2, y3, y4, y5, y6,
391 . z1, z2, z3, z4, z5, z6,
392 . vx1, vx2, vx3, vx4, vx5, vx6,
393 . vy1, vy2, vy3, vy4, vy5, vy6,
394 . vz1, vz2, vz3, vz4, vz5, vz6,
395 . vd2,vis,gbuf%OFF,offg,gbuf%SMSTR,gbuf%RHO,rhoo,
396 . r11, r12, r13, r21, r22, r23, r31, r32, r33,
397 . nc1,nc2,nc3,nc4,nc5,nc6,ngl,mxt,ngeo,
398 . ioutprt, vgxa, vgya, vgza, vga2,dd,
399 . nel, xgxa, xgya, xgza,xgxa2,xgya2,xgza2,
400 . xgxya,xgyza,xgzxa,iparg(1,ng),gbuf%GAMA_R)
401C
402 nn_del = 0
403 pid = ngeo(1)
404 IF (geo(190,pid)+geo(191,pid)+geo(192,pid)+geo(192,pid)>zero)
405 . nn_del=6
406 IF (nn_del ==0 .AND. dt%IDEL_BRICK>0) nn_del=6
407 mx = mxt(1)
408 c1 =pm(32,mx)
409 ipres = mat_elem%MAT_PARAM(mx)%IPRES
410 isctl = igeo(97,pid)
411 DO i=1,nel
412 sigzm(i) = zero
413 volm(i) = zero
414 nu(i)=min(half,pm(21,mx))
415 e0(i) =three*(one-two*nu(i))*c1
416 usb(i)=em01/c1
417 stin(i)=zero
418 conden(i)= zero
419 ENDDO
420C
421 IF (icp==1) THEN
422 DO i=1,nel
423 nu1(i)=half
424 ENDDO
425 ELSEIF (icp==2) THEN
426 CALL s8csigp3(gbuf%SIG,e0 ,gbuf%PLA,fac,gbuf%G_PLA,nel)
427 DO i=1,nel
428 nu1(i)=nu(i)+(half-nu(i))*fac(i)
429 ENDDO
430 ELSE
431 DO i=1,nel
432 nu1(i) =nu(i)
433 ENDDO
434 ENDIF
435C
436 CALL s6cderi3(
437 1 offg, voln, ngl, x1,
438 2 x2, x3, x4, x5,
439 3 x6, y1, y2, y3,
440 4 y4, y5, y6, z1,
441 5 z2, z3, z4, z5,
442 6 z6, px1, px2, px3,
443 7 px4, py1, py2, py3,
444 8 py4, pz1, pz2, pz3,
445 9 pz4, px1h, px2h, px3h,
446 a py1h, py2h, py3h, pz1h,
447 b pz2h, pz3h, jac1, jac2,
448 c jac3, jac4, jac5, jac6,
449 d jaci33, b1x, b1y, b2y,
450 e b2x, b1122, b1221, b2212,
451 f b1121, b1xh, b1yh, b2xh,
452 g b2yh, b1122h, b1221h, b2212h,
453 h b1121h, vzl, volg, gbuf%SMSTR,
454 i gbuf%OFF, nel, ismstr)
455 CALL sdlen3(
456 1 volg, deltax, x1, x2,
457 2 x5, x4, x3, x3,
458 3 x6, x6, y1, y2,
459 4 y5, y4, y3, y3,
460 5 y6, y6, z1, z2,
461 6 z5, z4, z3, z3,
462 7 z6, z6, n1x, n2x,
463 8 n3x, n4x, n5x, n6x,
464 9 n1y, n2y, n3y, n4y,
465 a n5y, n6y, n1z, n2z,
466 b n3z, n4z, n5z, n6z,
467 c nel, mtn, jale, jeul)
468 IF (ntsheg > 0.AND.isctl == 0) THEN
469 CALL sdlensh3n(volg,llsh,area ,
470 . x1, x2, x3, x4, x5, x6,
471 . y1, y2, y3, y4, y5, y6,
472 . z1, z2, z3, z4, z5, z6,nel)
473 alpha_e(1:nel) = one
474 DO i=1,nel
475 IF (gbuf%IDT_TSH(i)<=0) cycle
476 facdp = 1.343*llsh(i)/deltax(i)
477 alpha_e(i) = facdp*facdp
478 deltax(i)=max(llsh(i),deltax(i))
479 ENDDO
480 END IF
481 CALL s6cdefc3(
482 1 px1, px2, px3, px4,
483 2 py1, py2, py3, py4,
484 3 pz1, pz2, pz3, pz4,
485 4 vx1, vx2, vx3, vx4,
486 5 vx5, vx6, vy1, vy2,
487 6 vy3, vy4, vy5, vy6,
488 7 vz1, vz2, vz3, vz4,
489 8 vz5, vz6, dcxx, dcxy,
490 9 dcxz, dcyx, dcyy, dcyz,
491 a dczx, dczy, dczz, dc4,
492 b dc5, dc6, wxx, wyy,
493 c wzz, dhxx, dhxy, dhxz,
494 d dhyx, dhyy, dhyz, dhzx,
495 e dhzy, dhzz, dh4, dh5,
496 f dh6, px1h, px2h, px3h,
497 g py1h, py2h, py3h, pz1h,
498 h pz2h, pz3h, jaci33, b1x,
499 i b1y, b2y, b2x, b1122,
500 j b1221, b2212, b1121, b1xh,
501 k b1yh, b2xh, b2yh, b1122h,
502 l b1221h, b2212h, b1121h, ddhv,
503 m nu1, nel)
504 CALL s6czero3(
505 1 f11, f21, f31, f12,
506 2 f22, f32, f13, f23,
507 3 f33, f14, f24, f34,
508 4 f15, f25, f35, f16,
509 5 f26, f36, gbuf%SIG, gbuf%EINT,
510 6 gbuf%RHO, gbuf%QVIS, gbuf%PLA, gbuf%EPSD,
511 7 gbuf%G_PLA, gbuf%G_EPSD,nel)
512C ------------------------------------------------------------------------------
513C Update reference configuration (possible future change to small strain option)
514C -------------------------------------------------------------------------------
515 IF (ismstr <= 3.OR.(ismstr==4.AND.jlag>0)) THEN
516 CALL s6sav3(
517 1 gbuf%OFF, gbuf%SMSTR,x1, x2,
518 2 x3, x4, x5, x6,
519 3 y1, y2, y3, y4,
520 4 y5, y6, z1, z2,
521 5 z3, z4, z5, z6,
522 6 nel)
523 END IF !(ISMSTR <= 3) THEN
524c
525 IF (isorth > 0) THEN
526 pid = ngeo(1)
527 IF (igtyp == 21) THEN
528 CALL sgetdir3(nel,rx,ry,rz,tx,ty,tz,
529 . r11,r21,r31,r12,r22,r32,
530 . gbuf%GAMA,dir,irep)
531 ENDIF
532 IF (igtyp == 22) THEN
533 nlymax= 200
534 ipang = 200
535 ipthk = ipang+nlymax
536 ippos = ipthk+nlymax
537 ipmat = 100
538 mtn0=mtn
539 DO i=1,nel
540 mxt0(i)=mxt(i)
541 shf(i)=geo(38,ngeo(i))
542 ENDDO
543 ENDIF
544 ENDIF
545c
546C---------------------------------------------------------
547C Compute non-local variable increment at each Gauss point
548C---------------------------------------------------------
549 IF (inloc > 0) THEN
550 l_nloc = nloc_dmg%L_NLOC
551 dnl => nloc_dmg%DNL(1:l_nloc) ! DNL = non local variable increment
552 DO ilay=1,nlay
553 DO i=1,nel
554 inod(1) = nloc_dmg%IDXI(nc1(i))
555 inod(2) = nloc_dmg%IDXI(nc2(i))
556 inod(3) = nloc_dmg%IDXI(nc3(i))
557 inod(4) = nloc_dmg%IDXI(nc4(i))
558 inod(5) = nloc_dmg%IDXI(nc5(i))
559 inod(6) = nloc_dmg%IDXI(nc6(i))
560 DO j = 1,6
561 ipos(j) = nloc_dmg%POSI(inod(j))+ilay-1
562 ENDDO
563 var_reg(i,ilay) = dnl(ipos(1)) + dnl(ipos(2)) + dnl(ipos(3)) +
564 . dnl(ipos(4)) + dnl(ipos(5)) + dnl(ipos(6))
565 var_reg(i,ilay) = var_reg(i,ilay)*one_over_6
566 ENDDO
567 ENDDO
568 ENDIF
569C---------------------------------------------------------
570c
571C--------------------------------------
572C Constant stress through the thickness
573C--------------------------------------
574 DO ilay=1,nlay
575 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
576 IF (igtyp == 22) THEN
577 mid=igeo(ipmat+ilay,pid)
578 mtn=nint(pm(19,mid))
579 ENDIF
580 DO i=1,nel
581 sigzm(i) = sigzm(i)+lbuf%VOL(i)*lbuf%SIG(i+2*nel)
582 volm(i) = volm(i) +lbuf%VOL(i)
583 ENDDO
584 ENDDO
585 IF (dt1 == zero) THEN
586 dti =zero
587 ELSE
588 dti = one/dt1
589 ENDIF
590C-------------------------------------------
591C Element temperature
592C-------------------------------------------
593 tempel(:) = zero
594 fheat(:) = zero
595 IF (jthe < 0) THEN
596 DO i=1,nel
597 tempel(i) = one_over_6 *(temp(nc1(i)) + temp(nc2(i))
598 . + temp(nc3(i)) + temp(nc4(i))
599 . + temp(nc5(i)) + temp(nc6(i)))
600 gbuf%TEMP(i) = tempel(i)
601 ENDDO
602 ENDIF
603 ioffs=0
604 DO i=1,nel
605 offs(i) = ep20
606 ENDDO
607 IF (jthe < 0) them(1:nel,1:6) = zero
608C---------------------------------------------
609C Loop on integration points through thickness
610C---------------------------------------------
611 DO ilay=1,nlay
612 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
613 IF (igtyp == 22) THEN
614 zt = geo(ippos+ilay,pid)
615 wt = geo(ipthk+ilay,pid)
616 mid=igeo(ipmat+ilay,pid)
617 mtn=nint(pm(19,mid))
618 DO i=1,nel
619 mxt(i)=mid
620 ENDDO
621 ELSE
622 zt = a_gauss(ilay,nlay)
623 wt = w_gauss(ilay,nlay)
624 ENDIF
625C
626 CALL scdefo3(
627 1 dxx, dxy, dxz, dyx,
628 2 dyy, dyz, dzx, dzy,
629 3 dzz, d4, d5, d6,
630 4 dcxx, dcxy, dcxz, dcyx,
631 5 dcyy, dcyz, dczx, dczy,
632 6 dczz, dc4, dc5, dc6,
633 7 dhxx, dhxy, dhxz, dhyx,
634 8 dhyy, dhyz, dhzx, dhzy,
635 9 dhzz, dh4, dh5, dh6,
636 a zt, wt, vzl, voln,
637 b volg, lbuf%VOL, ddhv, lbuf%SIG,
638 c sigzm, volm, usb, lbuf%EINT,
639 d off, offg, dti, gbuf%OFF,
640 e dsv, lbuf%VOL0DP,voldp, ipres,
641 f nel )
642 DO i=1,nel
643 rhoo(i)= lbuf%RHO(i)
644 ENDDO
645 IF (isorth > 0) THEN
646 IF (igtyp == 22)
647 . CALL sgetdir3(nel,rx,ry,rz,tx,ty,tz,
648 . r11,r21,r31,r12,r22,r32,
649 . lbuf%GAMA,dir,irep)
650 CALL scordef3(nel,dxx,dyy,dzz,d4,d5,d6,dir)
651 IF (igtyp == 22) THEN
652 DO i=1,nel
653 d5(i)=shf(i)*d5(i)
654 d6(i)=shf(i)*d6(i)
655 ENDDO
656 ENDIF
657 ENDIF
658C
659 divde(1:nel) = dt1*(dxx(1:nel)+ dyy(1:nel)+ dzz(1:nel))+dsv(1:nel)
660 CALL srho3(
661 1 pm, lbuf%VOL, lbuf%RHO, lbuf%EINT,
662 2 divde, flux(1,nf1),flu1(nf1), voln,
663 3 dvol, ngl, mxt, off,
664 4 0, gbuf%TAG22, voldp, lbuf%VOL0DP,
665 5 amu, gbuf%OFF, nel, mtn,
666 6 jale, ismstr, jeul, jlag)
667C
668C-----------------------------
669C Gather stresses
670C-----------------------------
671 CALL csmall3(lbuf%SIG,s1,s2,s3,s4,s5,s6,
672 . gbuf%OFF,off,nel)
673C------------------------------------------------------
674C Compute new stresses according to constitutive laws
675C------------------------------------------------------
676 current_layer=ilay ! one treatment pass LAY to negative
677 CALL mmain(timers, output,
678 1 elbuf_tab, ng, pm, geo,
679 2 ale_connect, ixs, iparg,
680 3 v, tf, npf, bufmat,
681 4 sti, x, dt2t, neltst,
682 5 ityptst, offset, nel, w,
683 6 off, ngeo, mxt, ngl,
684 7 voln, vd2, dvol, deltax,
685 8 vis, qvis, cxx, s1,
686 9 s2, s3, s4, s5,
687 a s6, dxx, dyy, dzz,
688 b d4, d5, d6, wxx,
689 c wyy, wzz, jac1, jac2,
690 d jac3, jac4, jac5, jac6,
691 e vdx, vdy, vdz, muvoid,
692 f ssp_eq, aire, sigy, et,
693 g r1_free, lbuf%PLA, r3_free, amu,
694 h dxx, dxy, dxz, dyx,
695 i dyy, dyz, dzx, dzy,
696 j dzz, ipm, gama, bid,
697 k bid, bid, bid, bid,
698 l bid, bid, istrain, tempel,
699 m die, iexpan, current_layer,mssa,
700 n dmels, ir, is, it,
701 o table, bid, bid, bid,
702 p bid, iparg(1,ng), igeo, conde,
703 q itask, nloc_dmg, var_reg(1,ilay),mat_elem,
704 r h3d_strain, jplasol, jsph, sz_r1_free,
705 * snpc, stf, sbufmat ,glob_therm,
706 * svis, sz_ix, iresp,
707 * n2d, th_strain, ngroup, tt,
708 . dt1, ntable, numelq, nummat,
709 . numgeo, numnod, numels,
710 . idel7nok, idtmin, maxfunc,
711 . imon_mat, userl_avail, impl_s,
712 . idyna, dt, fheat ,sensors, opt_mtn=mtn,opt_jcvt=jcvt,
713 . opt_isorth=isorth,opt_isorthg=isorthg)
714C
715 DO i=1,nel
716 stin(i) = stin(i)+sti(i)
717 ENDDO
718C
719 IF(glob_therm%NODADT_THERM == 1) THEN
720 DO i=1,nel
721 conden(i)= conden(i)+ conde(i)
722 ENDDO
723 ENDIF
724 IF (istrain == 1) THEN
725 CALL sstra3(
726 1 dxx, dyy, dzz, d4,
727 2 d5, d6, lbuf%STRA,wxx,
728 3 wyy, wzz, off, nel,
729 4 jcvt)
730 ENDIF
731C----------------------------
732C Internal forces
733C----------------------------
734 l_pla = elbuf_tab(ng)%BUFLY(ilay)%L_PLA
735 l_epsd = elbuf_tab(ng)%BUFLY(ilay)%L_EPSD
736 IF (isorth > 0) THEN
737 CALL scroto_sig(nel,lbuf%SIG,sign,dir)
738!! SCROTO() temporary replaced by (the same) SCROTO_SIG() in order to do not affect
739!! the other multidimensional buffer ARRAYS which are still not modified
740 CALL s6cfint3(
741 1 sign, px1, px2, px3,
742 2 px4, py1, py2, py3,
743 3 py4, pz1, pz2, pz3,
744 4 pz4, px1h, px2h, px3h,
745 5 py1h, py2h, py3h, pz1h,
746 6 pz2h, pz3h, jaci33, b1x,
747 7 b1y, b2y, b2x, b1122,
748 8 b1221, b2212, b1121, b1xh,
749 9 b1yh, b2xh, b2yh, b1122h,
750 a b1221h, b2212h, b1121h, f11,
751 b f21, f31, f12, f22,
752 c f32, f13, f23, f33,
753 d f14, f24, f34, f15,
754 e f25, f35, f16, f26,
755 f f36, voln, qvis, lbuf%EINT,
756 g lbuf%RHO, lbuf%QVIS, lbuf%PLA, lbuf%EPSD,
757 h gbuf%EPSD, gbuf%SIG, gbuf%EINT, gbuf%RHO,
758 i gbuf%QVIS, gbuf%PLA, zt, wt,
759 j volg, off, nu1, lbuf%VOL,
760 k gbuf%VOL, l_pla, l_epsd, nel,
761 l svis, gbuf%WPLA, lbuf%WPLA, gbuf%G_WPLA )
762 ELSE
763 CALL s6cfint3(
764 1 lbuf%SIG, px1, px2, px3,
765 2 px4, py1, py2, py3,
766 3 py4, pz1, pz2, pz3,
767 4 pz4, px1h, px2h, px3h,
768 5 py1h, py2h, py3h, pz1h,
769 6 pz2h, pz3h, jaci33, b1x,
770 7 b1y, b2y, b2x, b1122,
771 8 b1221, b2212, b1121, b1xh,
772 9 b1yh, b2xh, b2yh, b1122h,
773 a b1221h, b2212h, b1121h, f11,
774 b f21, f31, f12, f22,
775 c f32, f13, f23, f33,
776 d f14, f24, f34, f15,
777 e f25, f35, f16, f26,
778 f f36, voln, qvis, lbuf%EINT,
779 g lbuf%RHO, lbuf%QVIS, lbuf%PLA, lbuf%EPSD,
780 h gbuf%EPSD, gbuf%SIG, gbuf%EINT, gbuf%RHO,
781 i gbuf%QVIS, gbuf%PLA, a_gauss(ilay,nlay),w_gauss(ilay,nlay),
782 j volg, off, nu1, lbuf%VOL,
783 k gbuf%VOL, l_pla, l_epsd, nel,
784 l svis, gbuf%WPLA, lbuf%WPLA, gbuf%G_WPLA )
785 ENDIF ! IF (ISORTH > 0)
786C-------------------------
787C Finite element heat transfert
788C--------------------------
789 IF (jthe < 0) THEN
790 imat = mxt(1)
791 IF (mat_elem%MAT_PARAM(imat)%HEAT_FLAG == 1) THEN
792 CALL s6ctherm(
793 1 pm ,imat ,voln ,nc1 ,
794 2 nc2 ,nc3 ,nc4 ,nc5 ,
795 3 nc6 ,px1 ,px2 ,px3 ,
796 4 px4 ,py1 ,py2 ,py3 ,
797 5 py4 ,pz1 ,pz2 ,pz3 ,
798 6 pz4 ,dt1 ,temp ,tempel ,
799 7 fheat ,them ,gbuf%OFF ,lbuf%OFF ,
800 8 nel ,glob_therm%THEACCFACT)
801 ELSE
802 END IF
803 CALL s6ctherm(
804 1 pm ,imat ,voln ,nc1 ,
805 2 nc2 ,nc3 ,nc4 ,nc5 ,
806 3 nc6 ,px1 ,px2 ,px3 ,
807 4 px4 ,py1 ,py2 ,py3 ,
808 5 py4 ,pz1 ,pz2 ,pz3 ,
809 6 pz4 ,dt1 ,temp ,tempel ,
810 7 die ,them ,gbuf%OFF ,lbuf%OFF ,
811 8 nel ,glob_therm%THEACCFACT)
812 ENDIF
813 DO i=1,nel
814 offg(i)=min(offg(i),off(i))
815 IF (lbuf%OFF(i) > one .AND. gbuf%OFF(i) == one) THEN
816 offs(i) = min(lbuf%OFF(i),offs(i))
817 ioffs = 1
818 END IF
819 ENDDO
820C-----------------------------
821 ENDDO ! ILAY=1,NLAY
822C-----------------------------
823c
824C-------------------------------
825C Non-local specific computation
826C-------------------------------
827 IF (inloc > 0) THEN
828 ! Computation of thickshell area
829 CALL sdlensh3n(volg,llsh,area ,
830 . x1, x2, x3, x4, x5, x6,
831 . y1, y2, y3, y4, y5, y6,
832 . z1, z2, z3, z4, z5, z6,nel)
833 ! Non-local internal forces
834 CALL s6cfint_reg(
835 1 nloc_dmg ,var_reg ,nel ,off ,
836 2 volg ,nc1 ,nc2 ,nc3 ,
837 3 nc4 ,nc5 ,nc6 ,px1 ,
838 4 px2 ,px3 ,px4 ,py1 ,
839 5 py2 ,py3 ,py4 ,pz1 ,
840 6 pz2 ,pz3 ,pz4 ,mxt(lft),
841 7 itask ,dt2t ,gbuf%VOL,nft ,
842 8 nlay ,w_gauss ,a_gauss ,area ,
843 9 elbuf_tab(ng)%NLOCTS(1,1))
844 ENDIF
845C--------------------------
846c
847 IF (ioffs == 1) THEN
848 DO i=1,nel
849 IF (offs(i)<=two)gbuf%OFF(i) = offs(i)
850 END DO
851 DO ilay=1,nlay
852 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
853 IF (igtyp == 22) THEN
854 mid=igeo(ipmat+ilay,pid)
855 mtn=nint(pm(19,mid))
856 ENDIF
857 DO i=1,nel
858 IF (gbuf%OFF(i) > one) lbuf%OFF(i)=gbuf%OFF(i)
859 END DO
860 END DO
861 END IF
862 IF (igtyp == 22) THEN
863 mtn = mtn0 !MTN0 may not be initialized if ISORTH == 0
864 DO i=1,nel
865 mxt(i)=mxt0(i)
866 ENDDO
867 ENDIF
868 IF ( nn_del> 0) THEN
869 CALL sdlensh3n2(volg,llsh,area ,
870 . x1, x2, x3, x4, x5, x6,
871 . y1, y2, y3, y4, y5, y6,
872 . z1, z2, z3, z4, z5, z6, nel)
873 CALL tshgeodel3(ngl,gbuf%OFF,volg,area,gbuf%VOL,
874 . llsh,geo(1,pid),nn_del,dt,nel )
875 ENDIF
876C-----------------------------
877C Hourglass
878C-----------------------------
879 IF ( impl_s == 0) THEN
880 IF (isctl > 0) THEN
881 dn = geo(13,pid)
882 CALL s6chour_ctl(
883 . x1, x2, x3, x4, x5, x6,
884 . y1, y2, y3, y4, y5, y6,
885 . z1, z2, z3, z4, z5, z6,
886 . vx1, vx2, vx3, vx4, vx5, vx6,
887 . vy1, vy2, vy3, vy4, vy5, vy6,
888 . vz1, vz2, vz3, vz4, vz5, vz6,
889 . f11, f12, f13, f14, f15, f16,
890 . f21, f22, f23, f24, f25, f26,
891 . f31, f32, f33, f34, f35, f36,
892 . pm,npropm, nummat,mtn,mxt,dn,
893 . gbuf%RHO,volg,cxx,gbuf%HOURG,
894 . off,gbuf%VOL,gbuf%EINT,dt1,stin,nel)
895 ELSE
896C
897 CALL s6chour3(gbuf%RHO,volg,cxx,
898 . x1, x2, x3, x3, x4, x5, x6, x6,
899 . y1, y2, y3, y3, y4, y5, y6, y6,
900 . z1, z2, z3, z3, z4, z5, z6, z6,
901 . vz1, vz2, vz3, vz3, vz4, vz5, vz6, vz6,
902 . f31,f32,f33,f34,f35,f36,
903 . nu,gbuf%HOURG,off,gbuf%VOL,gbuf%EINT,nel)
904 END IF !(ISCTL > 0) THEN
905 ENDIF
906C-----------------------------
907C Small strain
908C-----------------------------
909 CALL smallb3(
910 1 gbuf%OFF,offg, nel, ismstr)
911C--------------------------------------
912C Balance per part in case of print out
913C--------------------------------------
914 iflag=mod(ncycle,ncpri)
915 IF (ioutprt>0) THEN
916 CALL s6cbilan(partsav,gbuf%EINT,gbuf%RHO,gbuf%RK ,gbuf%VOL,
917 . vgxa, vgya, vgza, vga2, volg,iparts,
918 . gresav,grth,igrth,gbuf%OFF,iexpan,gbuf%EINTTH,
919 . gbuf%FILL, xgxa, xgya, xgza,xgxa2,xgya2,xgza2,
920 . xgxya,xgyza,xgzxa,itask,iparg(1,ng),gbuf%OFF,
921 . sensors,nel,gbuf%G_WPLA,gbuf%WPLA)
922 ENDIF
923C--------------------------------
924C Convected frame to global frame
925C--------------------------------
926 CALL s6proj3(
927 1 x1, x2, x3, x4,
928 2 x5, x6, y1, y2,
929 3 y3, y4, y5, y6,
930 4 z1, z2, z3, z4,
931 5 z5, z6, f11, f12,
932 6 f13, f14, f15, f16,
933 7 f21, f22, f23, f24,
934 8 f25, f26, f31, f32,
935 9 f33, f34, f35, f36,
936 a dd, nel)
937 CALL vrrota3(
938 1 r11, r21, r31, r12,
939 2 r22, r32, r13, r23,
940 3 r33, f11, f21, f31,
941 4 nel)
942 CALL vrrota3(
943 1 r11, r21, r31, r12,
944 2 r22, r32, r13, r23,
945 3 r33, f12, f22, f32,
946 4 nel)
947 CALL vrrota3(
948 1 r11, r21, r31, r12,
949 2 r22, r32, r13, r23,
950 3 r33, f13, f23, f33,
951 4 nel)
952 CALL vrrota3(
953 1 r11, r21, r31, r12,
954 2 r22, r32, r13, r23,
955 3 r33, f14, f24, f34,
956 4 nel)
957 CALL vrrota3(
958 1 r11, r21, r31, r12,
959 2 r22, r32, r13, r23,
960 3 r33, f15, f25, f35,
961 4 nel)
962 CALL vrrota3(
963 1 r11, r21, r31, r12,
964 2 r22, r32, r13, r23,
965 3 r33, f16, f26, f36,
966 4 nel)
967C----------------------------
968C distortion control
969C----------------------------
970 IF (isctl > 0) THEN
971 alpha_e(1:nel) = one
972 CALL sdistor_ini(
973 1 nel ,sti_c ,npropm ,nummat ,
974 2 ismstr ,mxt ,istab ,pm ,
975 3 gbuf%SIG ,gbuf%RHO ,cxx ,offg ,
976 4 gbuf%OFF ,ll ,voln ,fld ,
977 5 cns2 ,fqmax )
978! all in global system
979 CALL s6get_xv(
980 . nc1, nc2, nc3,
981 . nc4, nc5, nc6,
982 . x1, x2, x3,
983 . x4, x5, x6,
984 . y1, y2, y3,
985 . y4, y5, y6,
986 . z1, z2, z3,
987 . z4, z5, z6,
988 . vx1, vx2, vx3,
989 . vx4, vx5, vx6,
990 . vy1, vy2, vy3,
991 . vy4, vy5, vy6,
992 . vz1, vz2, vz3,
993 . vz4, vz5, vz6,
994 . x, xdp, v,
995 . numnod, ismstr, nel )
996 CALL s6for_distor(
997 . x1, x2, x3,
998 . x4, x5, x6,
999 . y1, y2, y3,
1000 . y4, y5, y6,
1001 . z1, z2, z3,
1002 . z4, z5, z6,
1003 . vx1, vx2, x3,
1004 . vx4, vx5, x6,
1005 . vy1, vy2, y3,
1006 . vy4, vy5, y6,
1007 . vz1, vz2, z3,
1008 . vz4, vz5, z6,
1009 . f11, f12, f13,
1010 . f14, f15, f16,
1011 . f21, f22, f23,
1012 . f24, f25, f26,
1013 . f31, f32, f33,
1014 . f34, f35, f36,
1015 . stin, sti_c, fld,
1016 . cns2, ll , istab,
1017 . fqmax,gbuf%EINT_DISTOR,dt1,
1018 . nel )
1019 ENDIF
1020C----------------------------
1021 IF(nfilsol/=0) CALL s6fillopt(
1022 1 gbuf%FILL,sti, f11, f21,
1023 2 f31, f12, f22, f32,
1024 3 f13, f23, f33, f14,
1025 4 f24, f34, f15, f25,
1026 5 f35, f16, f26, f36,
1027 6 nel)
1028C----------------------------
1029C Assemble nodal forces
1030C----------------------------
1031 IF (iparit == 0) THEN
1032 CALL s6cumu3(
1033 1 gbuf%OFF,a, nc1, nc2,
1034 2 nc3, nc4, nc5, nc6,
1035 3 stifn, stin, f11, f21,
1036 4 f31, f12, f22, f32,
1037 5 f13, f23, f33, f14,
1038 6 f24, f34, f15, f25,
1039 7 f35, f16, f26, f36,
1040 8 nel, jthe, fthe, them,
1041 9 condn,conden, ifthe, icondn,
1042 . glob_therm%NODADT_THERM)
1043 ELSE
1044 CALL s6cumu3p(
1045 1 gbuf%OFF,stin, fsky, fsky,
1046 2 iads, f11, f21, f31,
1047 3 f12, f22, f32, f13,
1048 4 f23, f33, f14, f24,
1049 5 f34, f15, f25, f35,
1050 6 f16, f26, f36, nel,
1051 7 nft, jthe, fthesky, them,
1052 8 condnsky,conden,
1053 . glob_therm%NODADT_THERM)
1054 ENDIF
1055 IF (ntsheg > 0)
1056 + CALL scumualpha6(
1057 1 gbuf%OFF,alpha_e, nc1, nc2,
1058 2 nc3, nc4, nc5, nc6,
1059 3 nel)
1060C-----------
1061 RETURN
1062 END SUBROUTINE s6cforc3
subroutine csmall3(sig, s1, s2, s3, s4, s5, s6, offg, off, nel)
Definition csmall3.F:35
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition mmain.F:43
subroutine s6cbilan(partsav, eint, rho, rk, vol, vxa, vya, vza, va2, vnew, iparts, gresav, grth, igrth, off, iexpan, eintth, fill, xx, yy, zz, xx2, yy2, zz2, xy, yz, zx, itask, iparg, offg, sensors, nel, g_wpla, wpla)
Definition s6cbilan.F:39
subroutine s6cdefc3(px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, vx1, vx2, vx3, vx4, vx5, vx6, vy1, vy2, vy3, vy4, vy5, vy6, vz1, vz2, vz3, vz4, vz5, vz6, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6, wxx, wyy, wzz, dhxx, dhxy, dhxz, dhyx, dhyy, dhyz, dhzx, dhzy, dhzz, dh4, dh5, dh6, px1h, px2h, px3h, py1h, py2h, py3h, pz1h, pz2h, pz3h, ji33, b1x, b1y, b2y, b2x, b1122, b1221, b2212, b1121, b1xh, b1yh, b2xh, b2yh, b1122h, b1221h, b2212h, b1121h, ddhv, nu, nel)
Definition s6cdefo3.F:51
subroutine s6cfint3(sig, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, px1h, px2h, px3h, py1h, py2h, py3h, pz1h, pz2h, pz3h, ji33, b1x, b1y, b2y, b2x, b1122, b1221, b2212, b1121, b1xh, b1yh, b2xh, b2yh, b1122h, b1221h, b2212h, b1121h, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, vol, qvis, eint, rho, q, epla, epsd, epsdm, sigm, eintm, rhom, qm, eplasm, zi, wi, volg, off, nu, vol0, vol0g, g_pla, g_epsd, nel, svis, g_wpla, l_wpla, g_wpla_flag)
Definition s6cfint3.F:50
subroutine s6cfint_reg(nloc_dmg, var_reg, nel, off, vol, nc1, nc2, nc3, nc4, nc5, nc6, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, imat, itask, dt2t, vol0, nft, nlay, ws, as, area, bufnlts)
Definition s6cfint_reg.F:41
subroutine s6cforc3(timers, output, elbuf_tab, ng, pm, geo, ixs, x, a, v, ms, w, flux, flu1, veul, fv, ale_connect, iparg, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, fsky, iads, offset, eani, iparts, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel, icp, icsig, nloc_dmg, ipm, istrain, igeo, gresav, grth, igrth, table, mssa, dmels, voln, itask, ioutprt, mat_elem, h3d_strain, temp, fthe, fthesky, condn, condnsky, iexpan, ifthe, icondn, dt, snpc, stf, sbufmat, svis, nsvois, idtmins, iresp, idel7ng, idel7nok, maxfunc, imon_mat, userl_avail, glob_therm, xdp, sensors)
Definition s6cforc3.F:100
subroutine s6chour3(rho, vol, ssp, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, f31, f32, f33, f35, f36, f37, nu, fhour, off, vol0, eint, nel)
Definition s6chourg3.F:35
subroutine sdlensh3n(nel, llsh3n, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
Definition s6cinit3.F:480
subroutine s6ctherm(pm, imat, vol, nc1, nc2, nc3, nc4, nc5, nc6, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, dt1, tempnc, tel, heat, fphi, offg, off, nel, theaccfact)
Definition s6ctherm.F:37
subroutine s6cumu3(offg, e, nc1, nc2, nc3, nc4, nc5, nc6, stifn, sti, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel, jthe, fthe, them, condn, conde, ifthe, icondn, nodadt_therm)
Definition s6cumu3.F:39
subroutine s6cumu3p(offg, sti, fsky, fskyv, iads, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel, nft, jthe, fthesky, them, condnsky, conde, nodadt_therm)
Definition s6cumu3p.F:37
subroutine s6czero3(fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fx5, fy5, fz5, fx6, fy6, fz6, sigm, eintm, rhom, qm, eplasm, epsdm, g_pla, g_epsd, nel)
Definition s6czero3.F:36
subroutine s6fillopt(fill, sti, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel)
Definition s6fillopt.F:35
subroutine s6proj3(x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, vx1, vx2, vx3, vx4, vx5, vx6, vy1, vy2, vy3, vy4, vy5, vy6, vz1, vz2, vz3, vz4, vz5, vz6, di, nel)
Definition s6proj3.F:40
subroutine s6rcoor3(x, ixs, v, w, gama0, gama, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, vx1, vx2, vx3, vx4, vx5, vx6, vy1, vy2, vy3, vy4, vy5, vy6, vz1, vz2, vz3, vz4, vz5, vz6, vd2, vis, offg, off, sav, rho, rhoo, r11, r12, r13, r21, r22, r23, r31, r32, r33, nc1, nc2, nc3, nc4, nc5, nc6, ngl, mxt, ngeo, ioutprt, vgax, vgay, vgaz, vga2, di, nel, xgax, xgay, xgaz, xgxa2, xgya2, xgza2, xgxya, xgyza, xgzxa, iparg, gama_r)
Definition s6rcoor3.F:46
subroutine s6sav3(offg, sav, xd1, xd2, xd3, xd4, xd5, xd6, yd1, yd2, yd3, yd4, yd5, yd6, zd1, zd2, zd3, zd4, zd5, zd6, nel)
Definition s6sav3.F:35
subroutine s8csigp3(sig, e0, defp, fac, g_pla, nel)
Definition s8csigp3.F:32
subroutine scdefo3(dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6, dcxx, dcxy, dcxz, dcyx, dcyy, dcyz, dczx, dczy, dczz, dc4, dc5, dc6, dhxx, dhxy, dhxz, dhyx, dhyy, dhyz, dhzx, dhzy, dhzz, dh4, dh5, dh6, zi, wi, vzl, vol, volg, volo, ddhv, sig, sigzm, volm, usb, eint, off, offg, dti, offs, dvc, vol0dp, voldp, ipres, nel)
Definition scdefo3.F:45
subroutine scordef3(nel, dxx, dyy, dzz, d4, d5, d6, dir)
Definition scordef3.F:33
subroutine scroto_sig(nel, sig, sign, dir)
Definition scroto_sig.F:30
subroutine scumualpha6(offg, alpha_e, nc1, nc2, nc3, nc4, nc5, nc6, nel)
Definition scumualpha6.F:34
subroutine sdlensh3n2(voln, llsh3n, area, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, nel)
Definition sdlensh3n2.F:35
subroutine sgetdir3(nel, rx, ry, rz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, dir, dirb, irep)
Definition sgetdir3.F:31
subroutine sgparav3(npe, x, ixs, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel)
Definition sgparav3.F:35
subroutine smallb3(offg, off, nel, ismstr)
Definition smallb3.F:44
subroutine sstra3(dxx, dyy, dzz, d4, d5, d6, strain, wxx, wyy, wzz, off, nel, jcvt)
Definition sstra3.F:46
subroutine sdlen3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, deltax, voln)
Definition sdlen3.F:41
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
Definition srho3.F:31
subroutine s6cderi3(nel, vol, geo, vzl, ngl, deltax, det, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
Definition s6cderi3.F:38
subroutine tshgeodel3(ngl, offg, volg, area, volg0, l_sh, geo, nnod, dt, nel)
Definition tshgeodel3.F:36
subroutine vrrota3(r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, y1, z1, nel)
Definition vrrota3.F:35