OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
insol3.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr03_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 462 of file insol3.F.

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

◆ 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 41 of file insol3.F.

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

◆ 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 190 of file insol3.F.

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