OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
build_cnel.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| build_cnel ../starter/source/model/mesh/build_cnel.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE build_cnel(
30 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
31 3 IXR ,IXTG ,IXS10 ,IXS20 ,
32 4 IXS16 ,IXTG1 ,IGEO ,KNOD2ELS ,KNOD2ELC ,
33 5 KNOD2ELTG ,NOD2ELS ,NOD2ELC ,NOD2ELTG ,CNEL ,
34 6 ADDCNEL ,KXX ,IXX ,X ,LELX ,
35 7 IXIG3D ,KXIG3D ,KNOD2ELIG3D,NOD2ELIG3D,KNOD2ELQ,
36 8 NOD2ELQ )
37 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "param_c.inc"
46#include "scr23_c.inc"
47#include "com04_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
52 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
53 . IXS10(6,*),IXS20(12,*),IXS16(8,*),IXTG1(4,*),
54 . IGEO(NPROPGI,*),KNOD2ELS(*),KNOD2ELC(*),KNOD2ELTG(*),
55 . NOD2ELS(*),NOD2ELC(*),NOD2ELTG(*),ADDCNEL(*),CNEL(*),
56 . KXX(NIXX,*),IXX(*),KXIG3D(NIXIG3D,*),IXIG3D(*),
57 . KNOD2ELIG3D(*),NOD2ELIG3D(*),KNOD2ELQ(*),NOD2ELQ(*)
58
59 my_real
60 . x(3,*),lelx(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, J, K, N, PX, PY, PZ
65C-----------------------------------------------
66C
67C PRE CONSTRUCTION ADDRESS
68C
69 DO k=2,9
70 DO i=1,numels
71 n = ixs(k,i)
72 IF(n/=0) knod2els(n) = knod2els(n) + 1
73 END DO
74 END DO
75C
76 DO k=1,6
77 DO i=1,numels10
78 n = ixs10(k,i)
79 IF(n/=0) knod2els(n) = knod2els(n) + 1
80 END DO
81 END DO
82C
83 DO k=1,12
84 DO i=1,numels20
85 n = ixs20(k,i)
86 IF(n/=0) knod2els(n) = knod2els(n) + 1
87 END DO
88 END DO
89C
90 DO k=1,8
91 DO i=1,numels16
92 n = ixs16(k,i)
93 IF(n/=0) knod2els(n) = knod2els(n) + 1
94 END DO
95 END DO
96C
97 DO i=1,numnod
98 knod2els(i+1) = knod2els(i+1) + knod2els(i)
99 END DO
100C
101 DO n=numnod,1,-1
102 knod2els(n+1)=knod2els(n)
103 END DO
104 knod2els(1)=0
105C
106 DO k=2,5
107 DO i=1,numelc
108 n = ixc(k,i)
109 knod2elc(n) = knod2elc(n) + 1
110 END DO
111 END DO
112C
113 DO i=1,numnod
114 knod2elc(i+1) = knod2elc(i+1) + knod2elc(i)
115 END DO
116C
117 DO n=numnod,1,-1
118 knod2elc(n+1)=knod2elc(n)
119 END DO
120 knod2elc(1)=0
121C
122 DO k=2,4
123 DO i=1,numeltg
124 n = ixtg(k,i)
125 knod2eltg(n) = knod2eltg(n) + 1
126 END DO
127 END DO
128C
129 DO k=1,3
130 DO i=1,numeltg6
131 n = ixtg1(k,i)
132 IF (n/=0) knod2eltg(n) = knod2eltg(n) + 1
133 END DO
134 END DO
135C
136 DO i=1,numnod
137 knod2eltg(i+1) = knod2eltg(i+1) + knod2eltg(i)
138 END DO
139C
140 DO n=numnod,1,-1
141 knod2eltg(n+1)=knod2eltg(n)
142 END DO
143 knod2eltg(1)=0
144C
145 DO i=1,numelig3d
146 px = igeo(41,kxig3d(2,i))
147 py = igeo(42,kxig3d(2,i))
148 pz = igeo(43,kxig3d(2,i))
149 DO k=1,px*py*pz
150 n = ixig3d(kxig3d(4,i)+k-1)
151 knod2elig3d(n) = knod2elig3d(n) + 1
152 END DO
153 END DO
154C
155 DO i=1,numnod
156 knod2elig3d(i+1) = knod2elig3d(i+1) + knod2elig3d(i)
157 END DO
158C
159 DO n=numnod,1,-1
160 knod2elig3d(n+1)=knod2elig3d(n)
161 END DO
162 knod2elig3d(1)=0
163
164C------------Quad elements nodes ----------
165C
166 DO k=2,5
167 DO i=1,numelq
168 n = ixq(k,i)
169 knod2elq(n) = knod2elq(n) + 1
170 END DO
171 END DO
172C
173 DO i=1,numnod
174 knod2elq(i+1) = knod2elq(i+1) + knod2elq(i)
175 END DO
176C
177 DO n=numnod,1,-1
178 knod2elq(n+1)=knod2elq(n)
179 END DO
180 knod2elq(1)=0
181C-----------------------------------------------
182 DO k=2,3
183 DO i=1,numelt
184 n = ixt(k,i)
185 addcnel(n) = addcnel(n) + 1
186 END DO
187 END DO
188
189 DO k=2,3
190 DO i=1,numelp
191 n = ixp(k,i)
192 addcnel(n) = addcnel(n) + 1
193 END DO
194 END DO
195
196 DO k=2,3
197 DO i=1,numelr
198 n = ixr(k,i)
199 addcnel(n) = addcnel(n) + 1
200 END DO
201 END DO
202
203 DO i=1,numelx
204 DO k=1,kxx(3,i)-1
205 n = ixx(kxx(4,i)+k)
206 addcnel(n) = addcnel(n) + 1
207 END DO
208 END DO
209
210 DO i=1,numnod
211 addcnel(i+1) = addcnel(i+1) + addcnel(i)
212 END DO
213
214 DO n=numnod,1,-1
215 addcnel(n+1)=addcnel(n)
216 END DO
217 addcnel(1)=0
218c Treatment apart from the 3rd optional node except type 12
219c DO I=1,NUMELR
220c N = IXR(4,I)
221c IF(IGEO(11,IXR(1,I))==12) ADDCNEL(N) = ADDCNEL(N) + 1
222c END DO
223C
224C-----------------------------------------------
225C
226C building the matrix Nod -> Solid element
227C
228 DO k=2,9
229 DO i=1,numels
230 n = ixs(k,i)
231 knod2els(n) = knod2els(n) + 1
232 IF(n/=0) nod2els(knod2els(n)) = i
233 END DO
234 END DO
235C
236 DO k=1,6
237 DO i=1,numels10
238 n = ixs10(k,i)
239 IF (n/=0) THEN
240 knod2els(n) = knod2els(n) + 1
241 nod2els(knod2els(n)) = numels8+i
242 END IF
243 END DO
244 END DO
245C
246 DO k=1,12
247 DO i=1,numels20
248 n = ixs20(k,i)
249 IF (n/=0) THEN
250 knod2els(n) = knod2els(n) + 1
251 nod2els(knod2els(n)) = numels10+numels8+i
252 END IF
253 END DO
254 END DO
255C
256 DO k=1,8
257 DO i=1,numels16
258 n = ixs16(k,i)
259 IF (n/=0) THEN
260 knod2els(n) = knod2els(n) + 1
261 nod2els(knod2els(n)) = numels20+numels10+numels8+i
262 END IF
263 END DO
264 END DO
265C
266 DO n=numnod,1,-1
267 knod2els(n+1)=knod2els(n)
268 END DO
269 knod2els(1)=0
270C
271C building the matrix Nod -> Shell element
272C
273 DO k=2,5
274 DO i=1,numelc
275 n = ixc(k,i)
276 knod2elc(n) = knod2elc(n) + 1
277 nod2elc(knod2elc(n)) = i
278 END DO
279 END DO
280C
281 DO n=numnod,1,-1
282 knod2elc(n+1)=knod2elc(n)
283 END DO
284 knod2elc(1)=0
285C
286C building the matrix Nod -> 3-node Shell element
287C
288 DO k=2,4
289 DO i=1,numeltg
290 n = ixtg(k,i)
291 knod2eltg(n) = knod2eltg(n) + 1
292 nod2eltg(knod2eltg(n)) = i
293 END DO
294 END DO
295C
296 DO k=1,3
297 DO i=1,numeltg6
298 n = ixtg1(k,i)
299 IF (n/=0) THEN
300 knod2eltg(n) = knod2eltg(n) + 1
301 nod2eltg(knod2eltg(n)) = numeltg-numeltg6+i
302 END IF
303 END DO
304 END DO
305C
306 DO n=numnod,1,-1
307 knod2eltg(n+1)=knod2eltg(n)
308 END DO
309 knod2eltg(1)=0
310
311 DO k=2,3
312 DO i=1,numelt
313 n = ixt(k,i)
314 addcnel(n) = addcnel(n) + 1
315 cnel(addcnel(n)) = i
316 END DO
317 END DO
318
319 DO k=2,3
320 DO i=1,numelp
321 n = ixp(k,i)
322 addcnel(n) = addcnel(n) + 1
323 cnel(addcnel(n)) = numelt+i
324 END DO
325 END DO
326
327 DO k=2,3
328 DO i=1,numelr
329 n = ixr(k,i)
330 addcnel(n) = addcnel(n) + 1
331 cnel(addcnel(n)) = numelt+numelp+i
332 END DO
333 END DO
334
335 DO i=1,numelx
336 DO k=1,kxx(3,i)-1
337 n = ixx(kxx(4,i)+k)
338 addcnel(n) = addcnel(n) + 1
339 cnel(addcnel(n)) = numelt+numelp+numelr+i
340 END DO
341 END DO
342
343 DO n=numnod,1,-1
344 addcnel(n+1)=addcnel(n)
345 END DO
346 addcnel(1)=0
347
348c fill LELX (use in I11STI3 and I20STI3E)
349 IF(numelx /= 0)THEN
350 lelx(1:numelx) = zero
351 DO i=1,numelx
352 DO j=kxx(4,i)+1,kxx(3,i)+kxx(4,i)-1
353 lelx(i) = lelx(i) +
354 . sqrt((x(1,ixx(j))-x(1,ixx(j-1)))**2
355 . +(x(2,ixx(j))-x(2,ixx(j-1)))**2
356 . +(x(3,ixx(j))-x(3,ixx(j-1)))**2)
357 ENDDO
358 ENDDO
359 ENDIF
360C
361 DO i=1,numelig3d
362 px = igeo(41,kxig3d(2,i))
363 py = igeo(42,kxig3d(2,i))
364 pz = igeo(43,kxig3d(2,i))
365 DO k=1,px*py*pz
366 n = ixig3d(kxig3d(4,i)+k-1)
367 knod2elig3d(n) = knod2elig3d(n) + 1
368 nod2elig3d(knod2elig3d(n)) = i
369 END DO
370 END DO
371C
372 DO n=numnod,1,-1
373 knod2elig3d(n+1)=knod2elig3d(n)
374 END DO
375 knod2elig3d(1)=0
376
377C------------Quad elements nodes ----------
378C building the matrix Nod -> Quad element
379C
380 DO k=2,5
381 DO i=1,numelq
382 n = ixq(k,i)
383 knod2elq(n) = knod2elq(n) + 1
384 nod2elq(knod2elq(n)) = i
385 END DO
386 END DO
387C
388 DO n=numnod,1,-1
389 knod2elq(n+1)=knod2elq(n)
390 END DO
391 knod2elq(1)=0
392C------------------------------------------------
393 RETURN
394 END
395!||====================================================================
396!|| prepare_int25 ../starter/source/model/mesh/build_cnel.F
397!||--- called by ------------------------------------------------------
398!|| lectur ../starter/source/starter/lectur.F
399!||--- calls -----------------------------------------------------
400!|| ancmsg ../starter/source/output/message/message.F
401!||--- uses -----------------------------------------------------
402!|| front_mod ../starter/share/modules1/front_mod.F
403!|| message_mod ../starter/share/message_module/message_mod.F
404!||====================================================================
405 SUBROUTINE prepare_int25(
406 1 INTBUF_TAB , IPARI, INTERCEP, NRTMT_25)
407C-----------------------------------------------
408C M o d u l e s
409C-----------------------------------------------
410 USE message_mod
411 USE intbufdef_mod
412 USE front_mod
413C-----------------------------------------------
414C I m p l i c i t T y p e s
415C-----------------------------------------------
416#include "implicit_f.inc"
417C-----------------------------------------------
418C C o m m o n B l o c k s
419C-----------------------------------------------
420#include "param_c.inc"
421#include "com01_c.inc"
422#include "com04_c.inc"
423#include "spmd_c.inc"
424C-----------------------------------------------
425C D u m m y A r g u m e n t s
426C-----------------------------------------------
427 INTEGER IPARI(NPARI,*), NRTMT_25
428 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
429 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
430C-----------------------------------------------
431C L o c a l V a r i a b l e s
432C-----------------------------------------------
433 INTEGER NIN, NTY, NRTM, NADMSR, NSN,
434 . NRTLM_L(NSPMD), K, P, N, IERROR
435 INTEGER, ALLOCATABLE, DIMENSION(:) :: IRTLM_L
436C-----------------------------------------------
437C
438C Pre calcul variables specifiques TYPE25
439C
440 numnor = 0
441 ninter25 = 0
442 nsnt25 = 0
443
444 nrtmx25 = 0
445
446 nrtmt_25 = 0
447
448 DO nin=1,ninter
449 nty=ipari(7,nin)
450
451 IF(nty/=25) cycle
452
453 ninter25 = ninter25 + 1
454
455 nrtm =ipari(4,nin)
456 nadmsr=ipari(67,nin)
457
458 numnor = numnor + nadmsr
459 nrtmt_25 = nrtmt_25 + nrtm
460
461 nsn = ipari(5,nin)
462 nsnt25 = nsnt25 + nsn
463
464 nrtmx25=max(nrtmx25,nrtm)
465 END DO
466
467 DO nin=1,ninter
468 nty=ipari(7,nin)
469 IF(nty/=25) cycle
470C
471 nrtm = ipari(4,nin)
472 nsn = ipari(5,nin)
473
474 ALLOCATE(irtlm_l(nrtm),stat=ierror)
475 IF (ierror /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
476 . msgtype=msgerror,
477 . c1='Prepare data related to /INTER/TYPE25')
478
479 nrtlm_l(1:nspmd)=0
480 DO k=1,nrtm
481 p = intercep(1,nin)%P(k)
482 nrtlm_l(p)=nrtlm_l(p)+1
483 irtlm_l(k)=nrtlm_l(p)
484 ENDDO
485
486 DO n=1,nsn
487C
488C IRTLM(3,-) <=> local segment number on IRTLM(4,-)
489 k = intbuf_tab(nin)%IRTLM(4*(n-1)+3)
490 IF(k /= 0)THEN
491 intbuf_tab(nin)%IRTLM(4*(n-1)+3)=irtlm_l(k)
492 intbuf_tab(nin)%IRTLM(4*(n-1)+4)=intercep(1,nin)%P(k)
493 END IF
494 END DO
495
496 DEALLOCATE(irtlm_l)
497 END DO
498
499 RETURN
500 END
501!||====================================================================
502!|| build_csrect ../starter/source/model/mesh/build_cnel.F
503!||--- called by ------------------------------------------------------
504!|| lectur ../starter/source/starter/lectur.F
505!||--- uses -----------------------------------------------------
506!||====================================================================
507 SUBROUTINE build_csrect(
508 1 INTBUF_TAB , IPARI, CSRECT ,ADDCSRECT )
509C-----------------------------------------------
510C M o d u l e s
511C-----------------------------------------------
512 USE intbufdef_mod
513C-----------------------------------------------
514C I m p l i c i t T y p e s
515C-----------------------------------------------
516#include "implicit_f.inc"
517C-----------------------------------------------
518C C o m m o n B l o c k s
519C-----------------------------------------------
520#include "param_c.inc"
521#include "com04_c.inc"
522C-----------------------------------------------
523C D u m m y A r g u m e n t s
524C-----------------------------------------------
525 TYPE(intbuf_struct_) INTBUF_TAB(*)
526 INTEGER IPARI(NPARI,*), ADDCSRECT(0:NUMNOR),CSRECT(*)
527C-----------------------------------------------
528C L o c a l V a r i a b l e s
529C-----------------------------------------------
530 INTEGER NIN, NTY, I, N, I1, I2, I3, I4, NRTM, NADMSR, ISHIFT
531C-----------------------------------------------
532C
533C PRE CONSTRUCTION ADDRESS
534C
535 addcsrect(0) = 0
536
537 ishift=0
538 DO nin=1,ninter
539 nty=ipari(7,nin)
540 IF(nty/=25) cycle
541
542 nrtm =ipari(4,nin)
543 nadmsr=ipari(67,nin)
544 DO n=1,nrtm
545 i1=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+1)
546 i2=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+2)
547 i3=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+3)
548 i4=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+4)
549 addcsrect(i1)=addcsrect(i1)+1
550 addcsrect(i2)=addcsrect(i2)+1
551 addcsrect(i3)=addcsrect(i3)+1
552 IF(i4/=i3) addcsrect(i4)=addcsrect(i4)+1
553 END DO
554C
555 DO i=ishift,ishift+nadmsr-1
556 addcsrect(i+1) = addcsrect(i+1) + addcsrect(i)
557 END DO
558C
559 DO n=ishift+nadmsr-1,ishift,-1
560 addcsrect(n+1)=addcsrect(n)
561 END DO
562C
563 DO n=1,nrtm
564 i1=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+1)
565 i2=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+2)
566 i3=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+3)
567 i4=ishift+intbuf_tab(nin)%ADMSR(4*(n-1)+4)
568 addcsrect(i1) = addcsrect(i1) + 1
569 csrect(addcsrect(i1)) = n
570 addcsrect(i2) = addcsrect(i2) + 1
571 csrect(addcsrect(i2)) = n
572 addcsrect(i3) = addcsrect(i3) + 1
573 csrect(addcsrect(i3)) = n
574 IF(i4/=i3)THEN
575 addcsrect(i4) = addcsrect(i4) + 1
576 csrect(addcsrect(i4)) = n
577 END IF
578 END DO
579C
580 DO n=ishift+nadmsr-1,ishift
581 addcsrect(n+1)=addcsrect(n)
582 END DO
583C
584 ishift=ishift+nadmsr
585
586 END DO
587C-----------------------------------------------
588 DO i=0,numnor
589 addcsrect(i)=addcsrect(i)+1
590 END DO
591C-----------------------------------------------
592 RETURN
593 END
build_cnel
subroutine build_cnel(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs20, ixs16, ixtg1, igeo, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, cnel, addcnel, kxx, ixx, x, lelx, ixig3d, kxig3d, knod2elig3d, nod2elig3d, knod2elq, nod2elq)
Definition build_cnel.F:37
prepare_int25
subroutine prepare_int25(intbuf_tab, ipari, intercep, nrtmt_25)
Definition build_cnel.F:407
build_csrect
subroutine build_csrect(intbuf_tab, ipari, csrect, addcsrect)
Definition build_cnel.F:509
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
front_mod
Definition front_mod.F:84
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