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 33 of file thickvar.F.

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