OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbtagn.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "fxbcom.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ fxbtagn()

subroutine fxbtagn ( integer, dimension(*) fxbnod,
integer nsn,
integer ntag,
integer, dimension(nibcld,*) ibcld,
integer, dimension(nibcld,*) ibprl,
integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nparg,*) iparg,
integer, dimension(*) itag,
integer nbmo,
integer nbml,
integer nels,
integer nelc,
integer neltg,
integer, dimension(nigrv,*) igrv,
integer, dimension(*) ibuf,
integer nlgrav,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer ifile,
integer nelt,
integer nelp )

Definition at line 29 of file fxbtagn.F.

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