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