OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11coq.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!|| i11coq ../starter/source/interfaces/inter3d1/i11coq.F
26!||--- called by ------------------------------------------------------
27!|| i11sti3 ../starter/source/interfaces/inter3d1/i11sti3.F
28!|| i20sti3e ../starter/source/interfaces/inter3d1/i20sti3.F
29!||====================================================================
30 SUBROUTINE i11coq(IRECT,IXC,IXTG,NINT,NEL,
31 . NELTG,IS ,GEO,PM,THK,IGEO,
32 . KNOD2ELC,KNOD2ELTG,NOD2ELC,NOD2ELTG,
33 . PM_STACK, IWORKSH)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "com01_c.inc"
42#include "com04_c.inc"
43#include "param_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NINT, NEL, IS, NELTG
48 INTEGER IRECT(2,*), IXC(NIXC,*), IXTG(NIXTG,*),IGEO(NPROPGI,*),
49 . KNOD2ELC(*),KNOD2ELTG(*),NOD2ELC(*),NOD2ELTG(*),IWORKSH(3,*)
50C REAL
51 my_real
52 . geo(npropg,*), pm(npropm,*),thk(*),pm_stack(20,*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER N, J, II, K, IAD,IGTYP,IPGMAT,IGMAT,ISUBSTACK
57C REAL
58 my_real
59 . dxm, stm, dx, st
60C
61 nel=0
62 neltg=0
63 dxm = zero
64 stm = zero
65 ipgmat = 700
66 igmat = 0
67 IF(numeltg/=0)THEN
68 DO 230 iad=knod2eltg(irect(1,is))+1,knod2eltg(irect(1,is)+1)
69 n = nod2eltg(iad)
70 DO 220 j=1,2
71 ii=irect(j,is)
72 DO 210 k=1,3
73 IF(ixtg(k+1,n)==ii) GOTO 220
74 210 CONTINUE
75 GOTO 230
76 220 CONTINUE
77 igtyp = geo(11,ixtg(5,n))
78 IF ( thk(numelc+n) /= zero .AND. iintthick == 0) THEN
79 dx=thk(numelc+n)
80 ELSEIF(igtyp ==17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
81 dx=thk(numelc+n)
82 ELSE
83 dx = geo(1,ixtg(5,n))
84 ENDIF
85 igmat = igeo(98,ixtg(5,n))
86 IF (ixtg(1,n)>0) THEN
87 st = pm(20,ixtg(1,n))
88 IF(igtyp == 11 .AND. igmat > 0) THEN
89 st=geo(ipgmat+2,ixtg(5,n))
90 ELSEIF(igtyp == 52 .OR.
91 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
92 isubstack = iworksh(3,numelc+n)
93 st=pm_stack(2,isubstack)
94 ENDIF
95 ELSE
96 st = zero
97 ENDIF
98 IF (dx>dxm) THEN
99 dxm = dx
100 neltg = n
101 stm = st
102 ELSEIF(dx==dxm) THEN
103 IF ((st>=stm).OR.(stm==zero)) THEN
104 neltg = n
105 stm = st
106 ENDIF
107 ENDIF
108 230 CONTINUE
109 ENDIF
110 IF(numelc/=0) THEN
111 DO 430 iad=knod2elc(irect(1,is))+1,knod2elc(irect(1,is)+1)
112 n = nod2elc(iad)
113 DO 420 j=1,2
114 ii=irect(j,is)
115 DO 410 k=1,4
116 IF(ixc(k+1,n)==ii) GOTO 420
117 410 CONTINUE
118 GOTO 430
119 420 CONTINUE
120 igtyp = igeo(11,ixc(6,n))
121 IF ( thk(n) /= zero .AND. iintthick == 0) THEN
122 dx=thk(n)
123 ELSEIF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
124 dx=thk(n)
125 ELSE
126 dx = geo(1,ixc(6,n))
127 ENDIF
128 igmat = igeo(98,ixc(6,n))
129 IF (ixc(1,n)>0) THEN
130 st = pm(20,ixc(1,n))
131 IF(igtyp == 11 .AND. igmat > 0)THEN
132 st=geo(ipgmat + 2 ,ixc(6,n))
133 ELSEIF(igtyp == 52 .OR.
134 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
135 isubstack = iworksh(3,n)
136 st=pm_stack(2,isubstack)
137 ENDIF
138 ELSE
139 st = 0.
140 ENDIF
141 IF (dx>dxm) THEN
142 dxm = dx
143 nel = n
144 stm = st
145 ELSEIF(dx==dxm) THEN
146 IF ((st>stm).OR.(stm==zero)) THEN
147 nel = n
148 stm = st
149 ENDIF
150 ENDIF
151 430 CONTINUE
152 ENDIF
153 RETURN
154 END
155C
156!||====================================================================
157!|| i11fil ../starter/source/interfaces/inter3d1/i11coq.F
158!||--- called by ------------------------------------------------------
159!|| i11sti3 ../starter/source/interfaces/inter3d1/i11sti3.F
160!|| i20sti3e ../starter/source/interfaces/inter3d1/i20sti3.F
161!||====================================================================
162 SUBROUTINE i11fil(IRECT,IXT,IXP,IXR,NINT,NELT,
163 . NELP,NELR,NELX,IS,NOD2EL1D,
164 . KNOD2EL1D,KXX,IXX)
165C-----------------------------------------------
166C I m p l i c i t T y p e s
167C-----------------------------------------------
168#include "implicit_f.inc"
169C-----------------------------------------------
170C C o m m o n B l o c k s
171C-----------------------------------------------
172#include "com04_c.inc"
173#include "scr23_c.inc"
174C-----------------------------------------------
175C D u m m y A r g u m e n t s
176C-----------------------------------------------
177 INTEGER NINT, NELT, IS, NELP, NELR, NELX
178 INTEGER IRECT(2,*),
179 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
180 . NOD2EL1D(*),KNOD2EL1D(*),KXX(NIXX,*),IXX(*)
181C-----------------------------------------------
182C L o c a l V a r i a b l e s
183C-----------------------------------------------
184 INTEGER N, J, II, K, IAD
185C
186 NELP=0
187 nelt=0
188 nelr=0
189 nelx=0
190 IF(numelt+numelp+numelr+numelx/=0)THEN
191 DO iad=knod2el1d(irect(1,is))+1,knod2el1d(irect(1,is)+1)
192 n = nod2el1d(iad)
193 IF(n>0.AND.n<=numelt)THEN
194 IF(irect(1,is)==ixt(2,n).AND.irect(2,is)==ixt(3,n).OR.
195 . irect(2,is)==ixt(2,n).AND.irect(1,is)==ixt(3,n))THEN
196 nelt=n
197 RETURN
198 ENDIF
199 ELSEIF(n>0.AND.n<=numelt+numelp)THEN
200 n=n-numelt
201 IF(irect(1,is)==ixp(2,n).AND.irect(2,is)==ixp(3,n).OR.
202 . irect(2,is)==ixp(2,n).AND.irect(1,is)==ixp(3,n))THEN
203 nelp=n
204 RETURN
205 ENDIF
206 ELSEIF(n>0.AND.n<=numelt+numelp+numelr)THEN
207 n=n-numelt-numelp
208 IF(irect(1,is)==ixr(2,n).AND.irect(2,is)==ixr(3,n).OR.
209 . irect(2,is)==ixr(2,n).AND.irect(1,is)==ixr(3,n).OR.
210 . irect(1,is)==ixr(3,n).AND.irect(2,is)==ixr(4,n).OR.
211 . irect(2,is)==ixr(3,n).AND.irect(1,is)==ixr(4,n))THEN
212 nelr=n
213 RETURN
214 ENDIF
215 ELSEIF(n>0.AND.n<=numelt+numelp+numelr+numelx)THEN
216 n=n-numelt-numelp-numelr
217 DO j=kxx(4,n),kxx(4,n)+kxx(3,n)-1
218 IF(irect(1,is)==ixx(j).AND.irect(2,is)==ixx(j+1).OR.
219 . irect(2,is)==ixx(j).AND.irect(1,is)==ixx(j+1))THEN
220 nelx=n
221 RETURN
222 ENDIF
223 ENDDO
224
225 ENDIF
226 ENDDO
227 ENDIF
228C
229 RETURN
230 END
my_real
#define my_real
Definition cppsort.cpp:32
i11coq
subroutine i11coq(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, thk, igeo, knod2elc, knod2eltg, nod2elc, nod2eltg, pm_stack, iworksh)
Definition i11coq.F:34
i11fil
subroutine i11fil(irect, ixt, ixp, ixr, nint, nelt, nelp, nelr, nelx, is, nod2el1d, knod2el1d, kxx, ixx)
Definition i11coq.F:165