OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
insol3.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine insol3 (x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
subroutine insol3d (x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20, tagelems, indexe, ninv, ielem_m, elem_linked_to_segment, print_error, nin25, nty, flag_elem_inter25)
subroutine i12sol3 (x, irect, ixs, nint, nel, i, area, noint, iadd, invc, nf, itab, knod2els, nod2els, nty, id, titr)

Function/Subroutine Documentation

◆ i12sol3()

subroutine i12sol3 ( x,
integer, dimension(4,*) irect,
integer, dimension(nixs,*) ixs,
integer nint,
integer nel,
integer i,
area,
integer noint,
integer, dimension(*) iadd,
integer, dimension(*) invc,
integer nf,
integer, dimension(*) itab,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
integer nty,
integer id,
character(len=nchartitle) titr )

Definition at line 455 of file insol3.F.

458C-----------------------------------------------
459C M o d u l e s
460C-----------------------------------------------
461 USE message_mod
462 USE names_and_titles_mod , ONLY : nchartitle
463C-----------------------------------------------
464C I m p l i c i t T y p e s
465C-----------------------------------------------
466#include "implicit_f.inc"
467C-----------------------------------------------
468C C o m m o n B l o c k s
469C-----------------------------------------------
470#include "com04_c.inc"
471C-----------------------------------------------
472C D u m m y A r g u m e n t s
473C-----------------------------------------------
474 INTEGER NINT, NEL, I, NOINT,IR, ITAB(*), KNOD2ELS(*), NOD2ELS(*)
475 my_real
476 . area
477 INTEGER IRECT(4,*), IXS(NIXS,*), IADD(*), INVC(*),NF,NTY
478 my_real
479 . x(3,*)
480 INTEGER ID
481 CHARACTER(LEN=NCHARTITLE) :: TITR
482C-----------------------------------------------
483C L o c a l V a r i a b l e s
484C-----------------------------------------------
485 INTEGER IY(4), N, JJ, II, K, NN, KK, IC, IAD,
486 . NUSER, NUSERM,IP(8),CON(8),IBID,MSEGTYP(NUMELS10)
487 my_real
488 . n1, n2, n3, dds
489 my_real :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
490C-----------------------------------------------
491C E x t e r n a l F u n c t i o n s
492C-----------------------------------------------
493 INTEGER IFACE
494 DATA con/1,2,3,4,5,6,7,8/
495C
496 ibid = 0
497 nel=0
498 ic=0
499 IF(numels==0) RETURN
500 IF(irect(1,i)>numnod) RETURN
501 nuserm = -1
502 DO 230 iad=iadd(irect(1,i)),iadd(irect(1,i)+1)-1
503 DO k=1,8
504 ip(k)=0
505 ENDDO
506 n = invc(iad)
507 IF(n>numelc+numeltg.AND.n<=numelc+numeltg+numels)THEN
508 n=n-numelc-numeltg
509 DO 220 jj=1,4
510 ii=irect(jj,i)
511 DO k=1,8
512 IF(ixs(k+1,n)==ii) THEN
513 ip(k)=1
514 GOTO 220
515 ENDIF
516 ENDDO
517 GOTO 230
518 220 CONTINUE
519 ic=ic+1
520 nf=iface(ip,con)
521 nuser = ixs(11,n)
522 IF (nuser>nuserm) THEN
523 nel = n
524 nuserm = nuser
525 ENDIF
526 ENDIF
527 230 CONTINUE
528 IF (nuserm==-1) RETURN
529 IF(nel>numels8.AND.nel<=numels8+numels10) THEN
530 DO k=1,nel-numels8
531 msegtyp(k)=10
532 ENDDO
533 0 CALL insolt10(
534 1 ixs(1,nel),ixs(1,numels+1),
535 2 irect(1,i),noint,nel-numels8,itab,
536 3 knod2els,nod2els,nty,ibid,msegtyp,
537 4 id,titr)
538 END IF !(NEL>NUMELS8.AND.NEL<=NUMELS8+NUMELS10) THEN
539C
540C 2 Elements connects 1 facette !
541C
542 IF(ic>=2)THEN
543 IF(nint>0) CALL ancmsg(msgid=1245,
544 . msgtype=msgerror,
545 . anmode=aninfo_blind,
546 . i1=i,
547 . prmod=msg_cumu)
548 IF(nint<0) CALL ancmsg(msgid=1246,
549 . msgtype=msgerror,
550 . anmode=aninfo_blind,
551 . i1=i,
552 . prmod=msg_cumu)
553 ENDIF
554
555C-----------------------------------------------
556C VERIFICATION DE L'ORIENTATION DES SEGMENTS
557C-----------------------------------------------
558 xs1=zero
559 ys1=zero
560 zs1=zero
561
562 DO 100 jj=1,4
563 nn=irect(jj,i)
564 iy(jj)=nn
565 xx1(jj)=x(1,nn)
566 xx2(jj)=x(2,nn)
567 xx3(jj)=x(3,nn)
568 xs1=xs1+fourth*x(1,nn)
569 ys1=ys1+fourth*x(2,nn)
570 100 zs1=zs1+fourth*x(3,nn)
571C
572 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
573 xc=zero
574 yc=zero
575 zc=zero
576 DO 110 k=1,8
577 kk=ixs(k+1,nel)
578 xc=xc+x(1,kk)
579 yc=yc+x(2,kk)
580 zc=zc+x(3,kk)
581 110 CONTINUE
582 xc=xc*one_over_8
583 yc=yc*one_over_8
584 zc=zc*one_over_8
585 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
586 IF(dds<0) RETURN
587 IF(iy(3)==iy(4)) THEN
588 irect(1,i)=iy(2)
589 irect(2,i)=iy(1)
590 ELSE
591 DO 120 kk=1,4
592 120 irect(kk,i)=iy(4-kk+1)
593 ENDIF
594
595 RETURN
596
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
iface
integer function iface(ip, n)
Definition iface.F:35
insolt10
subroutine insolt10(ixs, ixs10, irect, noint, nrtm, itab, knod2els, nod2els, nty, nsv, msegtyp, id, titr)
Definition insolt10.F:34
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
norma1
subroutine norma1(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:38
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

◆ insol3()

subroutine insol3 ( x,
integer, dimension(4,*) irect,
integer, dimension(nixs,*) ixs,
integer nint,
integer nel,
integer i,
area,
integer noint,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
integer ir,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20 )

Definition at line 40 of file insol3.F.

43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com04_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NINT, NEL, I, NOINT,IR
55 my_real
56 . area
57 INTEGER IRECT(4,*), IXS(NIXS,*), KNOD2ELS(*), NOD2ELS(*),
58 . IXS10(6,*), IXS16(8,*), IXS20(12,*)
59 my_real
60 . x(3,*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER IY(4), N, JJ, II, K, NN, KK, IC, IAD,
65 . NUSER, NUSERM
66 my_real
67 . n1, n2, n3, dds
68 my_real :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
69C-----------------------------------------------
70C E x t e r n a l F u n c t i o n s
71C-----------------------------------------------
72C
73 nel=0
74 ic=0
75 IF(numels==0) RETURN
76 IF(irect(1,i)>numnod) RETURN
77 nuserm = -1
78 IF (nint<0) nuser = noint
79 DO 230 iad=knod2els(irect(1,i))+1,knod2els(irect(1,i)+1)
80 n = nod2els(iad)
81 IF(n <= numels8)THEN
82 DO 210 jj=1,4
83 ii=irect(jj,i)
84 DO k=1,8
85 IF(ixs(k+1,n)==ii) GOTO 210
86 ENDDO
87 GOTO 230
88 210 CONTINUE
89 ELSEIF(n <= numels8+numels10)THEN
90 DO 220 jj=1,4
91 ii=irect(jj,i)
92 DO k=1,8
93 IF(ixs(k+1,n)==ii) GOTO 220
94 ENDDO
95 DO k=1,6
96 IF(ixs10(k,n-numels8)==ii) GOTO 220
97 ENDDO
98 GOTO 230
99 220 CONTINUE
100 ELSEIF(n <= numels8+numels10+numels20)THEN
101 DO 222 jj=1,4
102 ii=irect(jj,i)
103 DO k=1,8
104 IF(ixs(k+1,n)==ii) GOTO 222
105 ENDDO
106 DO k=1,12
107 IF(ixs20(k,n-numels8-numels10)==ii) GOTO 222
108 ENDDO
109 GOTO 230
110 222 CONTINUE
111 ELSEIF(n <= numels8+numels10+numels20+numels16)THEN
112 DO 224 jj=1,4
113 ii=irect(jj,i)
114 DO k=1,8
115 IF(ixs(k+1,n)==ii) GOTO 224
116 ENDDO
117 DO k=1,8
118 IF(ixs16(k,n-numels8-numels10-numels20)==ii) GOTO 224
119 ENDDO
120 GOTO 230
121 224 CONTINUE
122 ELSE
123 GOTO 230
124 END IF
125 ic=ic+1
126 nuser = ixs(11,n)
127 IF (nuser>nuserm) THEN
128 nel = n
129 nuserm = nuser
130 ENDIF
131 230 CONTINUE
132 IF (nuserm==-1) RETURN
133C-----------------------------------------------
134C VERIFICATION DE L'ORIENTATION DES SEGMENTS
135C-----------------------------------------------
136 xs1=zero
137 ys1=zero
138 zs1=zero
139 DO 100 jj=1,4
140 nn=irect(jj,i)
141 iy(jj)=nn
142 xx1(jj)=x(1,nn)
143 xx2(jj)=x(2,nn)
144 xx3(jj)=x(3,nn)
145 xs1=xs1+fourth*x(1,nn)
146 ys1=ys1+fourth*x(2,nn)
147 100 zs1=zs1+fourth*x(3,nn)
148C
149 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
150 xc=zero
151 yc=zero
152 zc=zero
153 DO 110 k=1,8
154 kk=ixs(k+1,nel)
155 xc=xc+x(1,kk)
156 yc=yc+x(2,kk)
157 zc=zc+x(3,kk)
158 110 CONTINUE
159 xc=xc*one_over_8
160 yc=yc*one_over_8
161 zc=zc*one_over_8
162 IF(ir/=0) RETURN
163 IF(ic>=2)RETURN
164 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
165 IF(dds<zero) RETURN
166 IF(iy(3)==iy(4)) THEN
167 irect(1,i)=iy(2)
168 irect(2,i)=iy(1)
169 ELSE
170 DO 120 kk=1,4
171 120 irect(kk,i)=iy(4-kk+1)
172 ENDIF
173 RETURN
174C

◆ insol3d()

subroutine insol3d ( x,
integer, dimension(4,*) irect,
integer, dimension(nixs,*) ixs,
integer nint,
integer nel,
integer i,
area,
integer noint,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
integer ir,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(numels), intent(inout) tagelems,
integer, dimension(numels), intent(inout) indexe,
integer ninv,
integer, dimension(2), intent(inout) ielem_m,
integer, dimension(numels), intent(inout) elem_linked_to_segment,
logical, intent(inout) print_error,
integer, intent(in) nin25,
integer, intent(in) nty,
integer, dimension(ninter25,numels), intent(in) flag_elem_inter25 )
Parameters
[in,out]elem_linked_to_segmentworking array, dim=numels
[in,out]print_errorflag : true if several elements seem to be duplicated

Definition at line 188 of file insol3.F.

193C-----------------------------------------------
194C M o d u l e s
195C-----------------------------------------------
196 USE message_mod
197C-----------------------------------------------
198C I m p l i c i t T y p e s
199C-----------------------------------------------
200#include "implicit_f.inc"
201C-----------------------------------------------
202C C o m m o n B l o c k s
203C-----------------------------------------------
204#include "com04_c.inc"
205#include "scr03_c.inc"
206C-----------------------------------------------
207C D u m m y A r g u m e n t s
208C-----------------------------------------------
209 INTEGER NINT, NEL, I, NOINT,IR,J,NINV
210 my_real
211 . area
212 INTEGER IRECT(4,*), IXS(NIXS,*), KNOD2ELS(*), NOD2ELS(*),
213 . IXS10(6,*), IXS16(8,*), IXS20(12,*)
214 INTEGER , INTENT(INOUT) :: TAGELEMS(NUMELS),INDEXE(NUMELS)
215 my_real
216 . x(3,*)
217 INTEGER , INTENT(INOUT) :: IELEM_M(2) ! ID of 1 or 2 solid elements attached to main segment
218 INTEGER, DIMENSION(NUMELS), INTENT(INOUT) :: ELEM_LINKED_TO_SEGMENT !< working array, dim=numels
219 LOGICAL, INTENT(INOUT) :: PRINT_ERROR !< flag : true if several elements seem to be duplicated
220 INTEGER, INTENT(IN) :: NIN25, NTY
221 INTEGER, INTENT(IN) :: FLAG_ELEM_INTER25(NINTER25,NUMELS)
222C-----------------------------------------------
223C L o c a l V a r i a b l e s
224C-----------------------------------------------
225 INTEGER IY(4), N, JJ, II, K, NN, KK, IC, IAD,
226 . NUSER, NUSERM, NINDEXE, IELS
227 INTEGER :: IJK
228 INTEGER :: ELEM_ID
229C REAL
230 my_real
231 . n1, n2, n3, dds
232 my_real :: xx1(4),xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
233C-----------------------------------------------
234C E x t e r n a l F u n c t i o n s
235C-----------------------------------------------
236C
237 nel=0
238 ic=0
239 print_error = .false.
240 IF(numels==0) RETURN
241 IF(irect(1,i)>numnod) RETURN
242
243 nindexe = 0
244 nuserm = -1
245 DO 230 iad=knod2els(irect(1,i))+1,knod2els(irect(1,i)+1)
246 n = nod2els(iad)
247 IF(n <= numels8)THEN
248 DO 210 jj=1,4
249 ii=irect(jj,i)
250 DO k=1,8
251 IF(ixs(k+1,n)==ii) GOTO 210
252 ENDDO
253 GOTO 230
254 210 CONTINUE
255 nuser = ixs(11,n)
256 IF(tagelems(n)==0) THEN
257 ic=ic+1
258 tagelems(n) = 1
259 nindexe = nindexe + 1
260 indexe(nindexe) = n
261 elem_linked_to_segment(ic) = n
262 IF (nuser>nuserm) THEN
263 nel = n
264 nuserm = nuser
265 ENDIF
266 ENDIF
267 ELSEIF(n <= numels8+numels10)THEN
268 DO 220 jj=1,4
269 ii=irect(jj,i)
270 DO k=1,8
271 IF(ixs(k+1,n)==ii) GOTO 220
272 ENDDO
273 DO k=1,6
274 IF(ixs10(k,n-numels8)==ii) GOTO 220
275 ENDDO
276 GOTO 230
277 220 CONTINUE
278 nuser = ixs(11,n)
279 IF(tagelems(n)==0) THEN
280 ic=ic+1
281 tagelems(n) = 1
282 nindexe = nindexe + 1
283 indexe(nindexe) = n
284 elem_linked_to_segment(ic) = n
285 IF (nuser>nuserm) THEN
286 nel = n
287 nuserm = nuser
288 ENDIF
289 ENDIF
290 ELSEIF(n <= numels8+numels10+numels20)THEN
291 DO 222 jj=1,4
292 ii=irect(jj,i)
293 DO k=1,8
294 IF(ixs(k+1,n)==ii) GOTO 222
295 ENDDO
296 DO k=1,12
297 IF(ixs20(k,n-numels8-numels10)==ii) GOTO 222
298 ENDDO
299 GOTO 230
300 222 CONTINUE
301 nuser = ixs(11,n)
302 IF(tagelems(n)==0) THEN
303 ic=ic+1
304 tagelems(n) = 1
305 nindexe = nindexe + 1
306 indexe(nindexe) = n
307 elem_linked_to_segment(ic) = n
308 IF (nuser>nuserm) THEN
309 nel = n
310 nuserm = nuser
311 ENDIF
312 ENDIF
313 ELSEIF(n <= numels8+numels10+numels20+numels16)THEN
314 DO 224 jj=1,4
315 ii=irect(jj,i)
316 DO k=1,8
317 IF(ixs(k+1,n)==ii) GOTO 224
318 ENDDO
319 DO k=1,8
320 IF(ixs16(k,n-numels8-numels10-numels20)==ii) GOTO 224
321 ENDDO
322 GOTO 230
323 224 CONTINUE
324 nuser = ixs(11,n)
325 IF(tagelems(n)==0) THEN
326 ic=ic+1
327 tagelems(n) = 1
328 nindexe = nindexe + 1
329 indexe(nindexe) = n
330 elem_linked_to_segment(ic) = n
331 IF (nuser>nuserm) THEN
332 nel = n
333 nuserm = nuser
334 ENDIF
335 ENDIF
336 ELSE
337 GOTO 230
338 END IF
339 230 CONTINUE
340 DO jj= 1,nindexe
341 n = indexe(jj)
342 tagelems(n) = 0
343 indexe(jj) = 0
344 ENDDO
345
346 IF (nuserm==-1) RETURN
347 IF(ic==1) THEN
348 ielem_m(1) = nel
349 ielem_m(2) = 0
350 ELSEIF(ic==2) THEN
351 ielem_m(1:2) = elem_linked_to_segment(1:2)
352 IF(ielem_m(1)/= nel) THEN
353 iels = ielem_m(1)
354 ielem_m(1) = ielem_m(2)
355 ielem_m(2) = iels
356 ENDIF
357 IF(nty==25) THEN
358 IF(flag_elem_inter25(nin25,ielem_m(1)) ==1.AND.flag_elem_inter25(nin25,ielem_m(2)) ==0) THEN
359 ic = 1
360 ELSEIF(flag_elem_inter25(nin25,ielem_m(1)) ==0.AND.flag_elem_inter25(nin25,ielem_m(2)) ==1) THEN
361 ic = 1
362 nel = ielem_m(2)
363 ielem_m(1) = ielem_m(2)
364 ielem_m(2) = 0
365 ENDIF
366 ENDIF
367
368 ELSE
369 ielem_m(1:2) = elem_linked_to_segment(1:2)
370 print_error = .true.
371 DO ijk=1,ic
372 elem_id = ixs(11,elem_linked_to_segment(ijk))
373 CALL ancmsg(msgid=3062,
374 . msgtype=msgwarning,
375 . anmode=aninfo_blind_1,
376 . i1=elem_id ,
377 . prmod=msg_cumu)
378 ENDDO
379 ENDIF
380C-----------------------------------------------
381C SEGMENTS ORIENTATION CHECKING
382C-----------------------------------------------
383 xs1=zero
384 ys1=zero
385 zs1=zero
386 DO 100 jj=1,4
387 nn=irect(jj,i)
388 iy(jj)=nn
389 xx1(jj)=x(1,nn)
390 xx2(jj)=x(2,nn)
391 xx3(jj)=x(3,nn)
392 xs1=xs1+fourth*x(1,nn)
393 ys1=ys1+fourth*x(2,nn)
394 100 zs1=zs1+fourth*x(3,nn)
395C
396 CALL norma1d(n1,n2,n3,area,xx1,xx2,xx3)
397
398 xc=0.
399 yc=0.
400 zc=0.
401 DO 110 k=1,8
402 kk=ixs(k+1,nel)
403 xc=xc+x(1,kk)
404 yc=yc+x(2,kk)
405 zc=zc+x(3,kk)
406 110 CONTINUE
407 xc=xc*one_over_8
408 yc=yc*one_over_8
409 zc=zc*one_over_8
410
411 IF(ir/=0) RETURN
412 IF(ic>=2)RETURN
413 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
414
415 IF(dds<zero) RETURN
416 IF(iy(3)==iy(4)) THEN
417 irect(1,i)=iy(2)
418 irect(2,i)=iy(1)
419 ELSE
420 DO 120 kk=1,4
421 120 irect(kk,i)=iy(4-kk+1)
422 ENDIF
423c IF(NINT>0) WRITE (IOUT,1300) I,NOINT
424c IF(NINT<0) WRITE (IOUT,1400) I,NOINT
425 ninv = ninv + 1
426 IF(ipri>=10.AND.nint>0)
427 . CALL ancmsg(msgid=3022,
428 . msgtype=msgwarning,
429 . anmode=aninfo_blind_1,
430 . i1=i,
431 . i2=noint,
432 . prmod=msg_cumu)
433 IF(ipri>=10.AND.nint< 0)
434 . CALL ancmsg(msgid=3024,
435 . msgtype=msgwarning,
436 . anmode=aninfo_blind_1,
437 . i1=i,
438 . i2=noint,
439 . prmod=msg_cumu)
440
441 RETURN
norma1d
subroutine norma1d(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:81