OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
err_thk.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "task_c.inc"
#include "vect01_c.inc"
#include "scr17_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ err_thk()

subroutine err_thk ( integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nparg,*) iparg,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
x,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer itask,
integer nodft,
integer nodlt,
err_thk_sh4,
err_thk_sh3,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
dimension(numelc) area_sh4,
dimension(numeltg) area_sh3,
dimension(numnod) area_nod,
dimension(numelc) thick_sh4,
dimension(numeltg) thick_sh3,
dimension(numnod) thick_nod )

Definition at line 37 of file err_thk.F.

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
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
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