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