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