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 38 of file err_thk.F.

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