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