OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thickvar.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 "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine thickvar (iparg, elbuf_tab, ixc, ixtg, thksh4_var, thksh3_var, thknod, thke, sh4tree, sh3tree)

Function/Subroutine Documentation

◆ thickvar()

subroutine thickvar ( integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
thksh4_var,
thksh3_var,
thknod,
thke,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree )

Definition at line 34 of file thickvar.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40 use element_mod , only : nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "comlock.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "remesh_c.inc"
53#include "task_c.inc"
54#include "vect01_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IPARG(NPARG,*), IXC(NIXC,*), IXTG(NIXTG,*),
59 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
60C REAL
61 my_real
62 . thksh4_var(*), thksh3_var(*), thknod(*),
63 . thke(*)
64 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER NG, I, J, N, NEL, ISH3N, IHBE, ITHK,
69 . LE,LELT,NELT(2*(4**LEVELMAX)),LEV,NE,SON,LELT1,LELT2
70 my_real
71 . thk
72 TYPE(G_BUFEL_) ,POINTER :: GBUF
73C-----------------------------------------------
74 IF(nadmesh==0)THEN
75 250 CONTINUE
76#include "lockon.inc"
77 IF(nsgdone>ngroup) THEN
78#include "lockoff.inc"
79 GOTO 252
80 ENDIF
81 ng=nsgdone
82 nsgdone = ng + 1
83#include "lockoff.inc"
84 IF (iparg(8,ng) == 1)GOTO 250
85 ity =iparg(5,ng)
86 IF(ity/=3.AND.ity/=7)GOTO 250
87
88 IF (iddw>0) CALL startimeg(ng)
89 mtn=iparg(1,ng)
90 IF(mtn == 0) GOTO 250
91 nel=iparg(2,ng)
92 nft=iparg(3,ng)
93 iad=iparg(4,ng)
94 ity=iparg(5,ng)
95 ihbe =iparg(23,ng)
96 ish3n =iparg(23,ng)
97 ithk = iparg(28,ng)
98 gbuf => elbuf_tab(ng)%GBUF
99c
100 IF (ity == 3) THEN
101 IF(ithk==0)THEN
102 DO i=1,nel
103 n=nft+i
104 thksh4_var(n)=thke(n)
105 DO j=2,5
106 thknod(ixc(j,n))=max(thknod(ixc(j,n)),thksh4_var(n))
107 END DO
108 END DO
109 ELSE
110 DO i=1,nel
111 n=nft+i
112 thksh4_var(n)=gbuf%THK(i)
113 DO j=2,5
114 thknod(ixc(j,n))=max(thknod(ixc(j,n)),thksh4_var(n))
115 END DO
116 END DO
117 END IF
118 ELSEIF(ity == 7)THEN
119 IF(ithk==0)THEN
120 DO i=1,nel
121 n=nft+i
122 thksh3_var(n)=thke(numelc+n)
123 DO j=2,4
124 thknod(ixtg(j,n))=max(thknod(ixtg(j,n)),thksh3_var(n))
125 END DO
126 END DO
127 ELSE
128 DO i=1,nel
129 n=nft+i
130 thksh3_var(n)=gbuf%THK(i)
131 DO j=2,4
132 thknod(ixtg(j,n))=max(thknod(ixtg(j,n)),thksh3_var(n))
133 END DO
134 END DO
135 END IF
136 END IF
137
138 IF (iddw>0) CALL stoptimeg(ng)
139 GOTO 250
140 252 CONTINUE
141C-----------------------------------------------
142 ELSE
143 450 CONTINUE
144#include "lockon.inc"
145 IF(nsgdone>ngroup) THEN
146#include "lockoff.inc"
147 GOTO 452
148 ENDIF
149 ng=nsgdone
150 nsgdone = ng + 1
151#include "lockoff.inc"
152 IF(iparg(8,ng) == 1)GOTO 450
153 ity =iparg(5,ng)
154 IF(ity/=3.AND.ity/=7)GOTO 450
155
156 IF (iddw>0) CALL startimeg(ng)
157 mtn=iparg(1,ng)
158 IF(mtn == 0) GOTO 450
159 nel=iparg(2,ng)
160 nft=iparg(3,ng)
161 iad=iparg(4,ng)
162 ity=iparg(5,ng)
163 ihbe =iparg(23,ng)
164 ish3n =iparg(23,ng)
165 ithk = iparg(28,ng)
166 gbuf => elbuf_tab(ng)%GBUF
167c
168 IF (ity == 3) THEN
169 DO i=1,nel
170 n=nft+i
171
172 lev=sh4tree(3,n)
173 IF(lev < 0 .OR. gbuf%OFF(i)==zero) cycle
174
175 IF(ithk==0)THEN
176 thk=thke(n)
177 ELSE
178 thk=gbuf%THK(i)
179 END IF
180
181 lelt =1
182 nelt(1)=n
183
184 lelt1 =0
185 lelt2 =1
186
187 DO WHILE (lev < levelmax)
188
189 DO le=lelt1+1,lelt2
190
191 ne =nelt(le)
192 son=sh4tree(2,ne)
193
194 IF(son==0) cycle
195
196 lelt=lelt+1
197 nelt(lelt)=son
198
199 lelt=lelt+1
200 nelt(lelt)=son+1
201
202 lelt=lelt+1
203 nelt(lelt)=son+2
204
205 lelt=lelt+1
206 nelt(lelt)=son+3
207
208 END DO
209
210 lev =lev+1
211 lelt1 =lelt2
212 lelt2 =lelt
213
214 END DO
215
216 DO le=1,lelt
217 ne =nelt(le)
218 thksh4_var(ne)=thk
219 DO j=2,5
220 thknod(ixc(j,ne))=max(thknod(ixc(j,ne)),thk)
221 END DO
222 END DO
223 END DO
224 ELSEIF(ity == 7)THEN
225 DO i=1,nel
226 n=nft+i
227
228 lev=sh3tree(3,n)
229 IF(lev < 0 .OR. gbuf%OFF(i)==zero) cycle
230
231 IF(ithk==0)THEN
232 thk=thke(n)
233 ELSE
234 thk=gbuf%THK(i)
235 END IF
236
237 lelt =1
238 nelt(1)=n
239
240 lelt1 =0
241 lelt2 =1
242
243 DO WHILE (lev < levelmax)
244
245 DO le=lelt1+1,lelt2
246
247 ne =nelt(le)
248 son=sh3tree(2,ne)
249
250 IF(son==0) cycle
251
252 lelt=lelt+1
253 nelt(lelt)=son
254
255 lelt=lelt+1
256 nelt(lelt)=son+1
257
258 lelt=lelt+1
259 nelt(lelt)=son+2
260
261 lelt=lelt+1
262 nelt(lelt)=son+3
263
264 END DO
265
266 lev =lev+1
267 lelt1 =lelt2
268 lelt2 =lelt
269
270 END DO
271 DO le=1,lelt
272 ne =nelt(le)
273 thksh3_var(ne)=thk
274 DO j=2,4
275 thknod(ixtg(j,ne))=max(thknod(ixtg(j,ne)),thk)
276 END DO
277 END DO
278 END DO
279 END IF
280
281 IF (iddw>0) CALL stoptimeg(ng)
282 GOTO 450
283 452 CONTINUE
284 END IF
285C-----------------------------------------------
286 RETURN
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
max
#define max(a, b)
Definition macros.h:21