OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
err_thk.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!|| err_thk ../engine/source/elements/shell/err_thk.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| admthke ../engine/source/model/remesh/admthke.F
29!|| my_barrier ../engine/source/system/machine.F
30!|| spmd_exch_nodarea ../engine/source/mpi/anim/spmd_exch_nodarea.F
31!|| startimeg ../engine/source/system/timer.F
32!|| stoptimeg ../engine/source/system/timer.F
33!||--- uses -----------------------------------------------------
34!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
35!|| element_mod ../common_source/modules/elements/element_mod.F90
36!|| message_mod ../engine/share/message_module/message_mod.F
37!||====================================================================
38 SUBROUTINE err_thk(
39 . IXC ,IXTG ,IPARG ,IAD_ELEM,FR_ELEM ,
40 . WEIGHT ,X ,ELBUF_TAB,IPART ,IPARTC ,
41 . IPARTTG ,ITASK ,NODFT ,NODLT ,ERR_THK_SH4,
42 . ERR_THK_SH3,SH4TREE,SH3TREE,
43 . AREA_SH4, AREA_SH3, AREA_NOD,
44 . THICK_SH4, THICK_SH3, THICK_NOD)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE message_mod
49 USE elbufdef_mod
50 use element_mod , only : nixc,nixtg
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "comlock.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com01_c.inc"
60#include "com04_c.inc"
61#include "param_c.inc"
62#include "remesh_c.inc"
63#include "task_c.inc"
64#include "vect01_c.inc"
65#include "scr17_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69C REAL
70 INTEGER
71 . IXC(NIXC,*), IXTG(NIXTG,*),IPARG(NPARG,*),
72 . IAD_ELEM(2,*), FR_ELEM(*), WEIGHT(*),
73 . IPART(LIPART1,*), IPARTC(*), IPARTTG(*),
74 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
75 INTEGER ITASK, NODFT, NODLT
76 my_real
77 . x(3,*), err_thk_sh4(*), err_thk_sh3(*)
78 TYPE(elbuf_struct_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
79 my_real, INTENT(INOUT),DIMENSION(NUMELC) :: AREA_SH4
80 my_real, INTENT(INOUT),DIMENSION(NUMELTG) :: AREA_SH3
81 my_real, INTENT(INOUT),DIMENSION(NUMNOD) :: area_nod
82 my_real, INTENT(INOUT),DIMENSION(NUMELC) :: thick_sh4
83 my_real, INTENT(INOUT),DIMENSION(NUMELTG) :: thick_sh3
84 my_real, INTENT(INOUT),DIMENSION(NUMNOD) :: thick_nod
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER SH4FT, SH4LT, SH3FT, SH3LT, MLW
89 INTEGER N1,N2,N3,N4,
90 . i,n,ng,nel,lenr,prt,iadm
91C REAL
92 my_real
93 . area, at,
94 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
95 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z,
96 . tn1,tn2,tn3,tn4,unt
97 TYPE(g_bufel_) ,POINTER :: GBUF
98C-----------------------------------------------
99C
100 sh4ft = 1+itask*numelc/ nthread
101 sh4lt = (itask+1)*numelc/nthread
102 sh3ft = 1+itask*numeltg/ nthread
103 sh3lt = (itask+1)*numeltg/nthread
104C
105 area_sh4(sh4ft:sh4lt)=zero
106 area_sh3(sh3ft:sh3lt)=zero
107C
108 err_thk_sh4(sh4ft:sh4lt)=zero
109 err_thk_sh3(sh3ft:sh3lt)=zero
110C
111 area_nod(nodft:nodlt)=zero
112 thick_nod(nodft:nodlt)=zero
113C
114 CALL my_barrier
115C
116C elts belonging to non adapted parts
117 DO ng=itask+1,ngroup,nthread
118
119 ity =iparg(5,ng)
120 IF(ity/=3.AND.ity/=7)GOTO 150
121 gbuf => elbuf_tab(ng)%GBUF
122
123 IF (iddw>0) CALL startimeg(ng)
124
125 nel =iparg(2,ng)
126 nft =iparg(3,ng)
127 npt =iparg(6,ng)
128 lft=1
129 llt=min(nvsiz,nel)
130
131 IF(ity==3)THEN
132 prt = ipartc(nft+1)
133 iadm= ipart(10,prt)
134 IF(iadm==0)THEN
135
136 DO i=lft,llt
137 n=nft+i
138 IF (gbuf%OFF(i) <= zero) cycle
139
140 n1=ixc(2,n)
141 n2=ixc(3,n)
142 n3=ixc(4,n)
143 n4=ixc(5,n)
144
145 x1=x(1,n1)
146 y1=x(2,n1)
147 z1=x(3,n1)
148 x2=x(1,n2)
149 y2=x(2,n2)
150 z2=x(3,n2)
151 x3=x(1,n3)
152 y3=x(2,n3)
153 z3=x(3,n3)
154 x4=x(1,n4)
155 y4=x(2,n4)
156 z4=x(3,n4)
157C
158 x31=x3-x1
159 y31=y3-y1
160 z31=z3-z1
161 x42=x4-x2
162 y42=y4-y2
163 z42=z4-z2
164
165 e3x=y31*z42-z31*y42
166 e3y=z31*x42-x31*z42
167 e3z=x31*y42-y31*x42
168
169 e3x=one_over_8*e3x
170 e3y=one_over_8*e3y
171 e3z=one_over_8*e3z
172
173 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
174 area_sh4(n)=area
175
176 thick_sh4(n)=gbuf%THK(i)
177 at = area * thick_sh4(n)
178
179#include "lockon.inc"
180 area_nod(n1)=area_nod(n1)+area
181 area_nod(n2)=area_nod(n2)+area
182 area_nod(n3)=area_nod(n3)+area
183 area_nod(n4)=area_nod(n4)+area
184 thick_nod(n1)=thick_nod(n1)+at
185 thick_nod(n2)=thick_nod(n2)+at
186 thick_nod(n3)=thick_nod(n3)+at
187 thick_nod(n4)=thick_nod(n4)+at
188#include "lockoff.inc"
189 END DO
190 END IF
191C
192 ELSE ! ITY==7
193 prt = iparttg(nft+1)
194 iadm= ipart(10,prt)
195 IF(iadm==0)THEN
196 DO i=lft,llt
197 n=nft+i
198 IF (gbuf%OFF(i) <= zero) cycle
199
200 n1=ixtg(2,n)
201 n2=ixtg(3,n)
202 n3=ixtg(4,n)
203 x1=x(1,n1)
204 y1=x(2,n1)
205 z1=x(3,n1)
206 x2=x(1,n2)
207 y2=x(2,n2)
208 z2=x(3,n2)
209 x3=x(1,n3)
210 y3=x(2,n3)
211 z3=x(3,n3)
212 x31=x3-x1
213 y31=y3-y1
214 z31=z3-z1
215 x32=x3-x2
216 y32=y3-y2
217 z32=z3-z2
218
219 e3x=y31*z32-z31*y32
220 e3y=z31*x32-x31*z32
221 e3z=x31*y32-y31*x32
222 e3x=one_over_6*e3x
223 e3y=one_over_6*e3y
224 e3z=one_over_6*e3z
225
226 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
227 area_sh3(n)=area
228
229 thick_sh3(n)=gbuf%THK(i)
230 at= area * thick_sh3(n)
231
232#include "lockon.inc"
233 area_nod(n1) =area_nod(n1)+area
234 area_nod(n2) =area_nod(n2)+area
235 area_nod(n3) =area_nod(n3)+area
236 thick_nod(n1)=thick_nod(n1)+at
237 thick_nod(n2)=thick_nod(n2)+at
238 thick_nod(n3)=thick_nod(n3)+at
239#include "lockoff.inc"
240 END DO
241 END IF
242 END IF
243 IF (iddw>0) CALL stoptimeg(ng)
244C
245 150 CONTINUE
246 END DO
247C
248 IF(nspmd > 1 ) THEN
249C
250 CALL my_barrier
251C
252 IF(itask == 0)THEN
253 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
254 CALL spmd_exch_nodarea(area_nod,iad_elem,fr_elem,lenr,weight)
255c LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
256 CALL spmd_exch_nodarea(thick_nod,iad_elem,fr_elem,lenr,weight)
257 END IF
258 END IF
259C
260 CALL my_barrier
261C
262C elts belonging to adapted parts
263 IF(nadmesh /= 0)THEN
264 IF(itask==0)THEN
265 CALL admthke(
266 . ixc ,ixtg ,x ,iparg ,elbuf_tab ,
267 . ipart ,ipartc ,iparttg ,iad_elem,fr_elem ,
268 . weight ,area_sh4,area_sh3,area_nod,thick_sh4 ,
269 . thick_sh3 ,thick_nod , err_thk_sh4, err_thk_sh3,
270 . sh4tree ,sh3tree)
271 END IF
272C
273 CALL my_barrier
274C
275 END IF
276C
277 DO ng=itask+1,ngroup,nthread
278
279 ity =iparg(5,ng)
280 IF(ity/=3.AND.ity/=7)GOTO 250
281 gbuf => elbuf_tab(ng)%GBUF
282
283 IF (iddw>0) CALL startimeg(ng)
284
285 mlw =iparg(1,ng)
286 nel =iparg(2,ng)
287 nft =iparg(3,ng)
288 npt = iparg(6,ng)
289 lft=1
290 llt=min(nvsiz,nel)
291
292 IF(ity==3)THEN
293 prt = ipartc(nft+1)
294 iadm= ipart(10,prt)
295 IF(iadm==0)THEN
296
297 DO i=lft,llt
298 n=nft+i
299 IF (gbuf%OFF(i) <= zero .OR. mlw == 0 .OR. mlw == 13) cycle
300
301 n1=ixc(2,n)
302 n2=ixc(3,n)
303 n3=ixc(4,n)
304 n4=ixc(5,n)
305
306 unt=one/thick_sh4(n)
307 tn1=abs(thick_nod(n1)/max(em30,area_nod(n1))*unt-one)
308 tn2=abs(thick_nod(n2)/max(em30,area_nod(n2))*unt-one)
309 tn3=abs(thick_nod(n3)/max(em30,area_nod(n3))*unt-one)
310 tn4=abs(thick_nod(n4)/max(em30,area_nod(n4))*unt-one)
311
312 err_thk_sh4(n)=fourth*(tn1+tn2+tn3+tn4)
313
314 END DO
315 END IF
316 ELSEIF(ity==7)THEN
317 prt = iparttg(nft+1)
318 iadm= ipart(10,prt)
319 IF(iadm==0)THEN
320 DO i=lft,llt
321 n=nft+i
322 IF (gbuf%OFF(i) <= zero .OR. mlw == 0 .OR. mlw == 13) cycle
323
324 n1=ixtg(2,n)
325 n2=ixtg(3,n)
326 n3=ixtg(4,n)
327
328 unt=one/thick_sh3(n)
329 tn1=abs(thick_nod(n1)/max(em30,area_nod(n1))*unt-one)
330 tn2=abs(thick_nod(n2)/max(em30,area_nod(n2))*unt-one)
331 tn3=abs(thick_nod(n3)/max(em30,area_nod(n3))*unt-one)
332
333 err_thk_sh3(n)=third*(tn1+tn2+tn3)
334
335 END DO
336 END IF
337 END IF
338
339 250 CONTINUE
340 END DO
341C
342 RETURN
343 END
344
345
admthke
subroutine admthke(ixc, ixtg, x, iparg, elbuf_tab, ipart, ipartc, iparttg, iad_elem, fr_elem, weight, area_sh4, area_sh3, area_nod, thick_sh4, thick_sh3, thick_nod, err_thk_sh4, err_thk_sh3, sh4tree, sh3tree)
Definition admthke.F:41
my_real
#define my_real
Definition cppsort.cpp:32
startimeg
subroutine startimeg(ng)
Definition timer.F:1371
stoptimeg
subroutine stoptimeg(ng)
Definition timer.F:1419
err_thk
subroutine err_thk(ixc, ixtg, iparg, iad_elem, fr_elem, weight, x, elbuf_tab, ipart, ipartc, iparttg, itask, nodft, nodlt, err_thk_sh4, err_thk_sh3, sh4tree, sh3tree, area_sh4, area_sh3, area_nod, thick_sh4, thick_sh3, thick_nod)
Definition err_thk.F:45
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
spmd_exch_nodarea
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodarea.F:41
my_barrier
subroutine my_barrier
Definition machine.F:31