OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbelnum.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!|| fxbelnum ../starter/source/constraints/fxbody/fxbelnum.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE fxbelnum(
30 . FXBNOD , NSN, IPARG, ITAG , FXBELM,
31 . IXS , IXC, IXTG , IPARTS, IPARTC,
32 . IPARTTG, IXT, IXP , IPARTT, IPARTP)
33 use element_mod , only : nixs,nixc,nixtg,nixt,nixp
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 "scr01_c.inc"
44#include "param_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER FXBNOD(*), NSN, IPARG(NPARG,*), ITAG(*), FXBELM(*),
49 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), IPARTS(*),
50 . IPARTC(*), IPARTTG(*), IXT(NIXT,*), IXP(NIXP,*),
51 . ipartt(*), ipartp(*)
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I,NG,NEL,NFT,ITY,II,NALL,NEL2,J,IAD,MAT,JHBE,IT1,IT2,IT3,IT4,IT5,IT6,IT7,IT8
56C=======================================================================
57 DO I=1,numnod
58 itag(i)=0
59 ENDDO
60 DO i=1,nsn
61 itag(abs(fxbnod(i)))=i
62 ENDDO
63 nel2=0
64C
65 DO ng=1,ngroup
66 nel=iparg(2,ng)
67 nft=iparg(3,ng)
68 iad=iparg(4,ng)
69 ity=iparg(5,ng)
70 jhbe=iparg(23,ng)
71C 1. Solid elements
72 IF(ity == 1)THEN
73 DO i=1,nel
74 ii=i+nft
75 it1=min(1,itag(ixs(2,ii)))
76 it2=min(1,itag(ixs(3,ii)))
77 it3=min(1,itag(ixs(4,ii)))
78 it4=min(1,itag(ixs(5,ii)))
79 it5=min(1,itag(ixs(6,ii)))
80 it6=min(1,itag(ixs(7,ii)))
81 it7=min(1,itag(ixs(8,ii)))
82 it8=min(1,itag(ixs(9,ii)))
83 nall = it1 * it2 * it3 * it4 * it5 * it6 * it7 * it8
84 IF (nall>0) THEN
85 mat=ixs(1,ii)
86 fxbelm(nel2+1)=ng
87 fxbelm(nel2+2)=i
88 DO j=1,8
89 fxbelm(nel2+2+j)=itag(ixs(1+j,ii))
90 ENDDO
91 fxbelm(nel2+13)=iparts(ii)
92 nel2=nel2+13
93 ENDIF
94 ENDDO
95C 3. 4-nodes shell elements
96 ELSEIF(ity == 3)THEN
97 DO i=1,nel
98 ii=i+nft
99 it1=min(1,itag(ixc(2,ii)))
100 it2=min(1,itag(ixc(3,ii)))
101 it3=min(1,itag(ixc(4,ii)))
102 it4=min(1,itag(ixc(5,ii)))
103 nall = it1 * it2 * it3 * it4
104 IF (nall>0) THEN
105 fxbelm(nel2+1)=ng
106 fxbelm(nel2+2)=i
107 DO j=1,4
108 fxbelm(nel2+2+j)=itag(ixc(1+j,ii))
109 ENDDO
110 fxbelm(nel2+10)=ipartc(ii)
111 nel2=nel2+10
112 ENDIF
113 ENDDO
114C 4. Truss elements
115 ELSEIF (ity == 4) THEN
116 DO i=1,nel
117 ii=i+nft
118 it1=min(1,itag(ixt(2,ii)))
119 it2=min(1,itag(ixt(3,ii)))
120 nall = it1 * it2
121 IF (nall>0) THEN
122 nb1=iad
123 nb2=nb1+nel
124 fxbelm(nel2+1)=ng
125 fxbelm(nel2+2)=i
126 DO j=1,2
127 fxbelm(nel2+2+j)=itag(ixt(1+j,ii))
128 ENDDO
129 fxbelm(nel2+5)=nb1+i-1
130 fxbelm(nel2+6)=nb2+i-1
131 fxbelm(nel2+7)=ipartt(ii)
132 nel2=nel2+7
133 ENDIF
134 ENDDO
135C 5. Beam elements
136 ELSEIF (ity == 5) THEN
137 DO i=1,nel
138 ii=i+nft
139 it1=min(1,itag(ixp(2,ii)))
140 it2=min(1,itag(ixp(3,ii)))
141 nall = it1 * it2
142 IF (nall>0) THEN
143 nb1=iad
144 nb2=nb1+nel
145 nb3=nb2+nel*3
146 nb4=nb3+nel*3
147 nb5=nb4+nel*2
148 nb6=nb5+nel
149 nb7=nb6+nel*3
150 fxbelm(nel2+1)=ng
151 fxbelm(nel2+2)=i
152 DO j=1,3
153 fxbelm(nel2+2+j)=itag(ixp(1+j,ii))
154 ENDDO
155 fxbelm(nel2+6)=nb2+3*(i-1)
156 fxbelm(nel2+7)=nb3+3*(i-1)
157 fxbelm(nel2+8)=nb4+2*(i-1)
158 fxbelm(nel2+9)=ipartp(ii)
159 nel2=nel2+9
160 ENDIF
161 ENDDO
162C 7. 3-nodes shell elements
163 ELSEIF(ity == 7)THEN
164 DO i=1,nel
165 ii=i+nft
166 it1=min(1,itag(ixtg(2,ii)))
167 it2=min(1,itag(ixtg(3,ii)))
168 it3=min(1,itag(ixtg(4,ii)))
169 nall = it1 * it2 * it3
170 IF (nall>0) THEN
171 fxbelm(nel2+1)=ng
172 fxbelm(nel2+2)=i
173 DO j=1,3
174 fxbelm(nel2+2+j)=itag(ixtg(1+j,ii))
175 ENDDO
176 fxbelm(nel2+9)=iparttg(ii)
177 nel2=nel2+9
178 ENDIF
179 ENDDO
180 ENDIF
181 ENDDO
182C-----------
183 RETURN
184 END SUBROUTINE fxbelnum
fxbelnum
subroutine fxbelnum(fxbnod, nsn, iparg, itag, fxbelm, ixs, ixc, ixtg, iparts, ipartc, iparttg, ixt, ixp, ipartt, ipartp)
Definition fxbelnum.F:33
min
#define min(a, b)
Definition macros.h:20