OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbtagn.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!|| fxbtagn ../starter/source/constraints/fxbody/fxbtagn.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE fxbtagn(FXBNOD, NSN , NTAG , IBCLD, IBPRL,
30 . IXS , IXC , IXT , IXP , IXR ,
31 . IXTG , IPARG, ITAG , NBMO , NBML ,
32 . NELS , NELC , NELTG, IGRV , IBUF ,
33 . NLGRAV, IPARI, INTBUF_TAB,IFILE, NELT ,
34 . NELP)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE intbufdef_mod
39 use element_mod , only : nixs,nixc,nixtg,nixt,nixp,nixr
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "param_c.inc"
50#include "scr03_c.inc"
51#include "fxbcom.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER FXBNOD(*), NSN, NTAG, IBCLD(NIBCLD,*), IBPRL(NIBCLD,*),
56 . IXS(NIXS,*), IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
57 . IXR(NIXR,*), IXTG(NIXTG,*), IPARG(NPARG,*), ITAG(*),
58 . NBMO, NBML, NELS, NELC, NELTG, IGRV(NIGRV,*),
59 . IBUF(*), NLGRAV, IPARI(NPARI,*), IFILE,
60 . nelt, nelp
61 TYPE(intbuf_struct_) INTBUF_TAB(*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,NG,MLW,ITY,NEL,NFT,IAD,II,NALL,J,FXBTAG(NSN),
66 . nn, nng, nngt, ig,
67 . itt(2,5), n, nty, nrts, nrtm, nmn, ins,
68 . ifac, inm
69C
70 DO i=1,numnod
71 itag(i)=0
72 ENDDO
73 DO i=1,nsn
74 itag(fxbnod(i))=1
75 fxbtag(i)=0
76 ENDDO
77 nels=0
78 nelc=0
79 neltg=0
80 nelt=0
81 nelp=0
82C-----------------------
83C Search boundary nodes
84C-----------------------
85 DO ng=1,ngroup
86 mlw=iparg(1,ng)
87 ity=iparg(5,ng)
88 nel=iparg(2,ng)
89 nft=iparg(3,ng)
90C 1. Solid elements
91 IF(ity==1)THEN
92 DO i=1,nel
93 ii=i+nft
94 nall = itag(ixs(2,ii)) * itag(ixs(3,ii)) *
95 + itag(ixs(4,ii)) * itag(ixs(5,ii)) *
96 + itag(ixs(6,ii)) * itag(ixs(7,ii)) *
97 + itag(ixs(8,ii)) * itag(ixs(9,ii))
98 IF(nall==0)THEN
99 DO j=1,8
100 IF (itag(ixs(j+1,ii))>0) itag(ixs(j+1,ii))=2
101 ENDDO
102 ELSE
103 nels=nels+1
104 ENDIF
105 ENDDO
106C 3. 4-nodes shell elements
107 ELSEIF(ity==3)THEN
108 DO i=1,nel
109 ii=i+nft
110 nall = itag(ixc(2,ii)) * itag(ixc(3,ii)) *
111 + itag(ixc(4,ii)) * itag(ixc(5,ii))
112 IF(nall==0)THEN
113 DO j=1,4
114 IF (itag(ixc(j+1,ii))>0) itag(ixc(j+1,ii))=2
115 ENDDO
116 ELSE
117 nelc=nelc+1
118 ENDIF
119 ENDDO
120C 4. Truss elements
121 ELSEIF(ity==4)THEN
122 DO i=1,nel
123 ii=i+nft
124 nall = itag(ixt(2,ii)) * itag(ixt(3,ii))
125 IF(nall==0)THEN
126 DO j=1,2
127 IF (itag(ixt(j+1,ii))>0) itag(ixt(j+1,ii))=2
128 ENDDO
129 ELSE
130 nelt=nelt+1
131 ENDIF
132 ENDDO
133C 5. Beam elements
134 ELSEIF(ity==5)THEN
135 DO i=1,nel
136 ii=i+nft
137 nall = itag(ixp(2,ii)) * itag(ixp(3,ii))
138 IF(nall==0)THEN
139 DO j=1,2
140 IF (itag(ixp(j+1,ii))>0) itag(ixp(j+1,ii))=2
141 ENDDO
142 ELSE
143 nelp=nelp+1
144 ENDIF
145 ENDDO
146C 6. Spring elements
147 ELSEIF(ity==6.AND.mlw/=3)THEN
148 DO i=1,nel
149 ii=i+nft
150 nall = itag(ixr(2,ii)) * itag(ixr(3,ii))
151 IF(nall==0)THEN
152 DO j=1,2
153 IF (itag(ixr(j+1,ii))>0) itag(ixr(j+1,ii))=2
154 ENDDO
155 ENDIF
156 ENDDO
157C 7. 3-nodes shell elements
158 ELSEIF(ity==7)THEN
159 DO i=1,nel
160 ii=i+nft
161 nall = itag(ixtg(2,ii)) * itag(ixtg(3,ii)) *
162 + itag(ixtg(4,ii))
163 IF(nall==0)THEN
164 DO j=1,3
165 IF (itag(ixtg(j+1,ii))>0) itag(ixtg(j+1,ii))=2
166 ENDDO
167 ELSE
168 neltg=neltg+1
169 ENDIF
170 ENDDO
171 ENDIF
172 ENDDO
173C-----------------------------------------
174C Search nodes in interfaces type 2, 7, 22
175C-----------------------------------------
176 DO n=1,ninter
177 nty =ipari(7,n)
178 nrts=ipari(3,n)
179 nrtm=ipari(4,n)
180 nn =ipari(5,n)
181 nmn =ipari(6,n)
182C
183 IF (nty==2) THEN
184 DO ii=1,nn
185 ins=intbuf_tab(n)%NSV(ii)
186 itt(1,1)=itag(ins)
187 itt(2,1)=ins
188 ifac=intbuf_tab(n)%IRTLM(ii)
189 DO j=1,4
190 inm=intbuf_tab(n)%IRECTM(4*(ifac-1)+j)
191 itt(1,1+j)=itag(inm)
192 itt(2,1+j)=inm
193 ENDDO
194 nall=itt(1,1)*itt(1,2)*itt(1,3)*itt(1,4)*itt(1,5)
195 IF (nall==0) THEN
196 DO j=1,5
197 IF (itt(1,j)/=0) itag(itt(2,j))=2
198 ENDDO
199 ENDIF
200 ENDDO
201 ELSEIF (nty==7.OR.nty==22) THEN
202 DO i=1,nn
203 ins=intbuf_tab(n)%NSV(i)
204 IF (itag(ins)/=0) itag(ins)=2
205 ENDDO
206 DO i=1,nrtm
207 DO j=1,4
208 inm=intbuf_tab(n)%IRECTM(4*(i-1)+j)
209 IF (itag(inm)/=0) itag(inm)=2
210 ENDDO
211 ENDDO
212 ENDIF
213 ENDDO
214C
215 DO i=1,nsn
216 ii=fxbnod(i)
217 IF (itag(ii)==2) fxbtag(i)=1
218 ENDDO
219C-------------------------------------------------------
220C Search nodes with concentrated loads or pressure loads
221C-------------------------------------------------------
222 DO i=1,numnod
223 itag(i)=0
224 ENDDO
225 DO i=1,nconld-npreld
226 ii=ibcld(1,i)
227 itag(ii)=1
228 ENDDO
229 DO i=1,npreld
230 DO j=1,4
231 ii=ibprl(j,i)
232 IF (ii>0) itag(ii)=1
233 ENDDO
234 ENDDO
235C
236 DO i=1,nsn
237 ii=fxbnod(i)
238 IF (itag(ii)>0) fxbtag(i)=1
239 ENDDO
240C
241 ntag=0
242 DO i=1,nsn
243 IF (fxbtag(i)==1) THEN
244 ntag=ntag+1
245 fxbnod(i)=-fxbnod(i)
246 ENDIF
247 ENDDO
248C
249 IF (ifile==0) THEN
250 lenmod=lenmod+nsn*nbmo
251 ELSEIF (ifile>=1) THEN
252 lenmod=lenmod+ntag*nbmo
253 ENDIF
254C
255 IF (nbml>0) THEN
256 lenelm=lenelm+nels*13+nelc*10+nelt*7+nelp*9+neltg*9
257 IF (ifile==0) lensig=lensig+(nels*7+nelc*10+nelt*2+nelp*8+neltg*10)*nbml
258 ENDIF
259C
260C-----------------------
261C Memory for gravity
262C-----------------------
263 nlgrav=0
264 nngt=0
265 DO ig=1,ngrav
266 DO i=1,numnod
267 itag(i)=0
268 ENDDO
269 nn=igrv(1,ig)
270 iad=igrv(4,ig)
271 DO ii=1,nn
272 itag(abs(ibuf(iad+ii-1)))=1
273 ENDDO
274 nng=0
275 DO i=1,nsn
276 ii=abs(fxbnod(i))
277 IF (itag(ii)>0) nng=nng+1
278 ENDDO
279 IF (nng>0) nlgrav=nlgrav+1
280 nngt=nngt+nng
281 ENDDO
282C
283 lengrvi=lengrvi+nngt+2*nlgrav
284 lengrvr=lengrvr+(nbmo-nbml)*nlgrav+nbml*9*nlgrav
285C
286 RETURN
287 END SUBROUTINE fxbtagn
fxbtagn
subroutine fxbtagn(fxbnod, nsn, ntag, ibcld, ibprl, ixs, ixc, ixt, ixp, ixr, ixtg, iparg, itag, nbmo, nbml, nels, nelc, neltg, igrv, ibuf, nlgrav, ipari, intbuf_tab, ifile, nelt, nelp)
Definition fxbtagn.F:35