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
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