OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
incoq3.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/.
23C
24!||====================================================================
25!|| incoq3 ../starter/source/interfaces/inter3d1/incoq3.F
26!||--- called by ------------------------------------------------------
27!|| i1chk3 ../starter/source/interfaces/inter3d1/i1chk3.F
28!|| i20sti3 ../starter/source/interfaces/inter3d1/i20sti3.F
29!|| i21els3 ../starter/source/interfaces/inter3d1/i21els3.F
30!|| i23gap3 ../starter/source/interfaces/inter3d1/i23gap3.F
31!|| i24gapm ../starter/source/interfaces/inter3d1/i24sti3.F
32!|| i25gapm ../starter/source/interfaces/inter3d1/i25sti3.F
33!|| i2buc1 ../starter/source/interfaces/inter3d1/i2buc1.F
34!|| i2chk3 ../starter/source/interfaces/inter3d1/i2chk3.F
35!|| i2cor3 ../starter/source/interfaces/inter3d1/i2cor3.F
36!|| i3sti3 ../starter/source/interfaces/inter3d1/i3sti3.F
37!|| i7sti3 ../starter/source/interfaces/inter3d1/i7sti3.F
38!|| inintr_orthdirfric ../starter/source/interfaces/interf1/inintr_orthdirfric.f
39!|| r2r_count ../starter/source/coupling/rad2rad/r2r_count.F
40!||--- uses -----------------------------------------------------
41!||====================================================================
42 SUBROUTINE incoq3(IRECT ,IXC ,IXTG ,NINT ,NEL ,
43 . NELTG ,IS ,GEO ,PM ,KNOD2ELC ,
44 . KNOD2ELTG ,NOD2ELC ,NOD2ELTG,THK,NTY,
45 . IGEO ,PM_STACK , IWORKSH )
46 use element_mod , only :nixc,nixtg
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "param_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NINT, NEL, IS, NELTG,NTY
61 INTEGER IRECT(4,*), IXC(NIXC,*), IXTG(NIXTG,*),
62 . KNOD2ELC(*) ,KNOD2ELTG(*) ,NOD2ELC(*) ,NOD2ELTG(*),
63 . igeo(npropgi,*),iworksh(3,*)
64C REAL
65 my_real
66 . geo(npropg,*), pm(npropm,*),thk(*),pm_stack(20,*)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER N, J, II, K, IAD,IGTYP, IPGMAT,IGMAT,ISUBSTACK
71C REAL
72 my_real
73 . dxm, stm, dx, st
74C-----------------------------------------------
75 nel=0
76 neltg=0
77 dxm = zero
78 stm = zero
79 ipgmat = 700
80 IF(irect(3,is)==irect(4,is).AND.numeltg/=0)THEN
81 IF(irect(1,is)>numnod) RETURN
82 DO 230 iad=knod2eltg(irect(1,is))+1,knod2eltg(irect(1,is)+1)
83 n = nod2eltg(iad)
84 DO 220 j=1,3
85 ii=irect(j,is)
86 DO 210 k=1,3
87 IF(ixtg(k+1,n)==ii) GOTO 220
88 210 CONTINUE
89 GOTO 230
90 220 CONTINUE
91 igtyp = igeo(11,ixtg(5,n))
92 IF ( thk(numelc+n) /= zero .AND. iintthick == 0 .AND.
93 . (nty == 7 .OR. nty == 20.OR. nty == 22)) THEN
94 dx=thk(numelc+n)
95 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR.igtyp ==52) THEN
96 dx=thk(numelc+n)
97 ELSE
98 dx = geo(1,ixtg(5,n))
99 ENDIF
100 igmat = igeo(98,ixtg(5,n))
101 IF (ixtg(1,n)>0) THEN
102 IF(igtyp == 11 .AND. igmat > 0) THEN
103 st = geo(ipgmat + 2 ,ixtg(5,n))
104 ELSEIF(igtyp ==52 .OR.
105 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
106 isubstack = iworksh(3,numelc + n)
107 st = pm_stack(2 ,isubstack)
108 ELSE
109 st = pm(20,ixtg(1,n))
110 ENDIF
111 ELSE
112 st = 0.
113 ENDIF
114 IF (dx>dxm) THEN
115 dxm = dx
116 neltg = n
117 stm = st
118 ELSEIF(dx==dxm) THEN
119 IF ((st>=stm).OR.(stm==0.)) THEN
120 neltg = n
121 stm = st
122 ENDIF
123 ENDIF
124 230 CONTINUE
125 ENDIF
126C
127 IF(numelc/=0) THEN
128 DO 430 iad=knod2elc(irect(1,is))+1,knod2elc(irect(1,is)+1)
129 n = nod2elc(iad)
130 DO 420 j=1,4
131 ii=irect(j,is)
132 DO 410 k=1,4
133 IF(ixc(k+1,n)==ii) GOTO 420
134 410 CONTINUE
135 GOTO 430
136 420 CONTINUE
137 igtyp = igeo(11,ixc(6,n))
138 IF ( thk(n) /= zero .AND. iintthick == 0 .AND.
139 . (nty == 7 .OR. nty == 20.OR. nty == 22)) THEN
140 dx=thk(n)
141 ELSEIF(igtyp == 17 .OR. igtyp ==51 .OR. igtyp ==52) THEN
142 dx=thk(n)
143 ELSE
144 dx = geo(1,ixc(6,n))
145 ENDIF
146 IF (ixc(1,n)>0) THEN
147 st = pm(20,ixc(1,n))
148 ELSE
149 st = zero
150 ENDIF
151 IF (dx>dxm) THEN
152 dxm = dx
153 nel = n
154 stm = st
155 ELSEIF(dx==dxm) THEN
156 IF ((st>stm).OR.(stm==zero)) THEN
157 nel = n
158 stm = st
159 ENDIF
160 ENDIF
161 430 CONTINUE
162 ENDIF
163 RETURN
164 END
my_real
#define my_real
Definition cppsort.cpp:32
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:46
inintr_orthdirfric
subroutine inintr_orthdirfric(ipari, intbuf_tab, intbuf_fric_tab, igeo, geo, x, ixtg, ixc, iparttg, ipartc, pfricorth, irepforth, phiforth, vforth, knod2elc, knod2eltg, nod2eltg, nod2elc, iworksh, pm, pm_stack, thk, skew, itab, ipart)
Definition inintr_orthdirfric.F:39
starter
program starter
Definition starter.F:39