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