OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
scdtchk3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine chk_dttsh (elbuf_str, ixs, iparg, ikine)

Function/Subroutine Documentation

◆ chk_dttsh()

subroutine chk_dttsh ( type(elbuf_struct_), dimension(ngroup), target elbuf_str,
integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(nparg,ngroup), intent(in) iparg,
integer, dimension(numnod*3), intent(in) ikine )

Definition at line 32 of file scdtchk3.F.

33C=======================================================================
34 USE my_alloc_mod
35 USE message_mod
36 USE elbufdef_mod
37 use element_mod , only : nixs
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C A n a l y s e M o d u l e
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER,DIMENSION(NIXS,NUMELS),INTENT(IN) :: IXS
50 INTEGER,DIMENSION(NPARG,NGROUP),INTENT(IN) :: IPARG
51 INTEGER,DIMENSION(NUMNOD*3),INTENT(IN) :: IKINE
52 TYPE(ELBUF_STRUCT_),DIMENSION(NGROUP), TARGET :: ELBUF_STR
53C REAL
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "param_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "scr03_c.inc"
61#include "scr17_c.inc"
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I, NG, NEL, NFT, N, ITY, JHBE, IGTYP, ICSTR, ISOLNOD
66 INTEGER N1,N2,NC(MVSIZ,8),NEDG,IER1,IER2,IKIN
67 INTEGER,DIMENSION(:),ALLOCATABLE :: ITAG
68 TYPE(G_BUFEL_) ,POINTER :: GBUF
69C REAL
70C-------
71 CALL my_alloc(itag,numnod)
72 itag(1:numnod)=0
73 nedg = 0
74 DO ng=1,ngroup
75 nel=iparg(2,ng)
76 nft=iparg(3,ng)
77 ity=iparg(5,ng)
78 icstr= iparg(17,ng)
79 jhbe = iparg(23,ng)
80 igtyp = iparg(38,ng)
81 isolnod= iparg(28,ng)
82 IF (iparg(8,ng)==1) cycle
83 IF (ity /= 1) cycle
84 IF (igtyp == 20.OR.igtyp == 21.OR.igtyp == 22)THEN
85C--------only linear for the moment
86 IF(isolnod==6)THEN
87 DO i=1,nel
88 n = nft+i
89 nc(i,1:3)=ixs(2:4,n)
90 nc(i,4:6)=ixs(6:8,n)
91 ENDDO
92 DO i=1,nel
93 n1 = nc(i,1)
94 n2 = nc(i,4)
95 IF (itag(n1)==0.AND.itag(n2)==0) THEN
96 nedg = nedg + 1
97 itag(n1)=nedg
98 itag(n2)=nedg
99 END IF
100 n1 = nc(i,2)
101 n2 = nc(i,5)
102 IF (itag(n1)==0.AND.itag(n2)==0) THEN
103 nedg = nedg + 1
104 itag(n1)=nedg
105 itag(n2)=nedg
106 END IF
107 n1 = nc(i,3)
108 n2 = nc(i,6)
109 IF (itag(n1)==0.AND.itag(n2)==0) THEN
110 nedg = nedg + 1
111 itag(n1)=nedg
112 itag(n2)=nedg
113 END IF
114 ENDDO
115 ELSEIF(isolnod==8)THEN
116 DO i=1,nel
117 n = nft+i
118 nc(i,1:8)=ixs(2:9,n)
119 ENDDO
120 IF (jhbe==14) THEN
121 SELECT CASE (icstr)
122 CASE(100)
123 DO i=1,nel
124 n1 = nc(i,1)
125 n2 = nc(i,4)
126 IF (itag(n1)==0.AND.itag(n2)==0) THEN
127 nedg = nedg + 1
128 itag(n1)=nedg
129 itag(n2)=nedg
130 END IF
131 n1 = nc(i,2)
132 n2 = nc(i,3)
133 IF (itag(n1)==0.AND.itag(n2)==0) THEN
134 nedg = nedg + 1
135 itag(n1)=nedg
136 itag(n2)=nedg
137 END IF
138 n1 = nc(i,5)
139 n2 = nc(i,8)
140 IF (itag(n1)==0.AND.itag(n2)==0) THEN
141 nedg = nedg + 1
142 itag(n1)=nedg
143 itag(n2)=nedg
144 END IF
145 n1 = nc(i,6)
146 n2 = nc(i,7)
147 IF (itag(n1)==0.AND.itag(n2)==0) THEN
148 nedg = nedg + 1
149 itag(n1)=nedg
150 itag(n2)=nedg
151 END IF
152 ENDDO
153 CASE(10)
154 DO i=1,nel
155 n1 = nc(i,1)
156 n2 = nc(i,5)
157 IF (itag(n1)==0.AND.itag(n2)==0) THEN
158 nedg = nedg + 1
159 itag(n1)=nedg
160 itag(n2)=nedg
161 END IF
162 n1 = nc(i,2)
163 n2 = nc(i,6)
164 IF (itag(n1)==0.AND.itag(n2)==0) THEN
165 nedg = nedg + 1
166 itag(n1)=nedg
167 itag(n2)=nedg
168 END IF
169 n1 = nc(i,3)
170 n2 = nc(i,7)
171 IF (itag(n1)==0.AND.itag(n2)==0) THEN
172 nedg = nedg + 1
173 itag(n1)=nedg
174 itag(n2)=nedg
175 END IF
176 n1 = nc(i,4)
177 n2 = nc(i,8)
178 IF (itag(n1)==0.AND.itag(n2)==0) THEN
179 nedg = nedg + 1
180 itag(n1)=nedg
181 itag(n2)=nedg
182 END IF
183 ENDDO
184 CASE(1)
185 DO i=1,nel
186 n1 = nc(i,1)
187 n2 = nc(i,2)
188 IF (itag(n1)==0.AND.itag(n2)==0) THEN
189 nedg = nedg + 1
190 itag(n1)=nedg
191 itag(n2)=nedg
192 END IF
193 n1 = nc(i,4)
194 n2 = nc(i,3)
195 IF (itag(n1)==0.AND.itag(n2)==0) THEN
196 nedg = nedg + 1
197 itag(n1)=nedg
198 itag(n2)=nedg
199 END IF
200 n1 = nc(i,5)
201 n2 = nc(i,6)
202 IF (itag(n1)==0.AND.itag(n2)==0) THEN
203 nedg = nedg + 1
204 itag(n1)=nedg
205 itag(n2)=nedg
206 END IF
207 n1 = nc(i,8)
208 n2 = nc(i,7)
209 IF (itag(n1)==0.AND.itag(n2)==0) THEN
210 nedg = nedg + 1
211 itag(n1)=nedg
212 itag(n2)=nedg
213 END IF
214 ENDDO
215 END SELECT
216 ELSEIF (jhbe==15) THEN
217 DO i=1,nel
218 n1 = nc(i,1)
219 n2 = nc(i,5)
220 IF (itag(n1)==0.AND.itag(n2)==0) THEN
221 nedg = nedg + 1
222 itag(n1)=nedg
223 itag(n2)=nedg
224 END IF
225 n1 = nc(i,2)
226 n2 = nc(i,6)
227 IF (itag(n1)==0.AND.itag(n2)==0) THEN
228 nedg = nedg + 1
229 itag(n1)=nedg
230 itag(n2)=nedg
231 END IF
232 n1 = nc(i,3)
233 n2 = nc(i,7)
234 IF (itag(n1)==0.AND.itag(n2)==0) THEN
235 nedg = nedg + 1
236 itag(n1)=nedg
237 itag(n2)=nedg
238 END IF
239 n1 = nc(i,4)
240 n2 = nc(i,8)
241 IF (itag(n1)==0.AND.itag(n2)==0) THEN
242 nedg = nedg + 1
243 itag(n1)=nedg
244 itag(n2)=nedg
245 END IF
246 ENDDO
247 END IF
248 END IF
249 END IF
250 ENDDO
251C-------uncompatibility commun node dif edge
252 ier1=0 !mesh
253 ier2=0 !kin
254 DO ng=1,ngroup
255 nel=iparg(2,ng)
256 nft=iparg(3,ng)
257 ity=iparg(5,ng)
258 icstr= iparg(17,ng)
259 jhbe = iparg(23,ng)
260 igtyp = iparg(38,ng)
261 isolnod= iparg(28,ng)
262 gbuf => elbuf_str(ng)%GBUF
263 IF (iparg(8,ng)==1) cycle
264 IF (ity /= 1) cycle
265 IF (igtyp == 20.OR.igtyp == 21.OR.igtyp == 22)THEN
266C--------only linear for the moment
267 IF(isolnod==6)THEN
268 DO i=1,nel
269 n = nft+i
270 nc(i,1:3)=ixs(2:4,n)
271 nc(i,4:6)=ixs(6:8,n)
272 ENDDO
273 DO i=1,nel
274 ikin = 0
275 n1 = nc(i,1)
276 n2 = nc(i,4)
277 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
278 IF (ikine(n1)/=ikine(n2)) ikin = 1
279 n1 = nc(i,2)
280 n2 = nc(i,5)
281 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
282 IF (ikine(n1)/=ikine(n2)) ikin = 1
283 n1 = nc(i,3)
284 n2 = nc(i,6)
285 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
286 IF (ikine(n1)/=ikine(n2)) ikin = 1
287 IF (ikin==1) gbuf%IDT_TSH(i)=-1
288 ENDDO
289 ELSEIF(isolnod==8)THEN
290 DO i=1,nel
291 n = nft+i
292 nc(i,1:8)=ixs(2:9,n)
293 ENDDO
294 IF (jhbe==14) THEN
295 SELECT CASE (icstr)
296 CASE(100)
297 DO i=1,nel
298 ikin = 0
299 n1 = nc(i,1)
300 n2 = nc(i,4)
301 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
302 IF (ikine(n1)/=ikine(n2)) ikin = 1
303 n1 = nc(i,2)
304 n2 = nc(i,3)
305 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
306 IF (ikine(n1)/=ikine(n2)) ikin = 1
307 n1 = nc(i,5)
308 n2 = nc(i,8)
309 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
310 IF (ikine(n1)/=ikine(n2)) ikin = 1
311 n1 = nc(i,6)
312 n2 = nc(i,7)
313 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
314 IF (ikin==1) gbuf%IDT_TSH(i)=-1
315 ENDDO
316 CASE(10)
317 DO i=1,nel
318 ikin = 0
319 n1 = nc(i,1)
320 n2 = nc(i,5)
321 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
322 IF (ikine(n1)/=ikine(n2)) ikin = 1
323 n1 = nc(i,2)
324 n2 = nc(i,6)
325 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
326 IF (ikine(n1)/=ikine(n2)) ikin = 1
327 n1 = nc(i,3)
328 n2 = nc(i,7)
329 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
330 IF (ikine(n1)/=ikine(n2)) ikin = 1
331 n1 = nc(i,4)
332 n2 = nc(i,8)
333 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
334 IF (ikine(n1)/=ikine(n2)) ikin = 1
335 IF (ikin==1) gbuf%IDT_TSH(i)=-1
336 ENDDO
337 CASE(1)
338 DO i=1,nel
339 ikin = 0
340 n1 = nc(i,1)
341 n2 = nc(i,2)
342 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
343 IF (ikine(n1)/=ikine(n2)) ikin = 1
344 n1 = nc(i,4)
345 n2 = nc(i,3)
346 IF (ikine(n1)/=ikine(n2)) ikin = 1
347 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
348 n1 = nc(i,5)
349 n2 = nc(i,6)
350 IF (ikine(n1)/=ikine(n2)) ikin = 1
351 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
352 n1 = nc(i,8)
353 n2 = nc(i,7)
354 IF (ikine(n1)/=ikine(n2)) ikin = 1
355 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
356 IF (ikin==1) gbuf%IDT_TSH(i)=-1
357 ENDDO
358 END SELECT
359 ELSEIF (jhbe==15) THEN
360 DO i=1,nel
361 ikin = 0
362 n1 = nc(i,1)
363 n2 = nc(i,5)
364 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
365 IF (ikine(n1)/=ikine(n2)) ikin = 1
366 n1 = nc(i,2)
367 n2 = nc(i,6)
368 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
369 IF (ikine(n1)/=ikine(n2)) ikin = 1
370 n1 = nc(i,3)
371 n2 = nc(i,7)
372 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
373 IF (ikine(n1)/=ikine(n2)) ikin = 1
374 n1 = nc(i,4)
375 n2 = nc(i,8)
376 IF (itag(n1)/=itag(n2)) gbuf%IDT_TSH(i)=0
377 IF (ikine(n1)/=ikine(n2)) ikin = 1
378 IF (ikin==1) gbuf%IDT_TSH(i)=-1
379 ENDDO
380 END IF
381 END IF
382 IF (idttsh>0 .AND.(isolnod==6.OR.isolnod==8)) THEN
383 DO i=1,nel
384 n = nft+i
385 IF (gbuf%IDT_TSH(i)==0) THEN
386 IF (ipri>0 ) CALL ancmsg(msgid=2070,
387 . msgtype=msginfo,
388 . anmode=aninfo_blind_1,
389 . i1=ixs(11,n),
390 . prmod=msg_cumu)
391 ier1=ier1+1
392 END IF
393 IF (gbuf%IDT_TSH(i)==-1) THEN
394 IF (ipri>0 ) CALL ancmsg(msgid=2071,
395 . msgtype=msginfo,
396 . anmode=aninfo_blind_1,
397 . i1=ixs(11,n),
398 . prmod=msg_cumu)
399 ier2=ier2+1
400 END IF
401 ENDDO
402 END IF
403 END IF
404 ENDDO
405C------ Out message
406 IF (idttsh>0 .AND.(ier1+ier2)>0) THEN
407 IF (ier1>0.AND. ipri>0 ) CALL ancmsg(msgid=2070,
408 . msgtype=msginfo,
409 . anmode=aninfo_blind_1,
410 . prmod=msg_print)
411 IF (ier2>0.AND. ipri>0 ) CALL ancmsg(msgid=2071,
412 . msgtype=msginfo,
413 . anmode=aninfo_blind_1,
414 . prmod=msg_print)
415 IF (ipri==0 ) CALL ancmsg(msgid=2069,
416 . msgtype=msginfo,
417 . anmode=aninfo_blind_1,
418 . i1=ier1,
419 . i2=ier2)
420 END IF
421C
422 DEALLOCATE(itag)
423 RETURN
message_mod
Definition message_mod.F:1257
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895