OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
reconnect.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!|| reconnect ../starter/source/elements/nodes/reconnect.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE reconnect(
30 . IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
31 . IXC ,IXT ,IXP ,IXR ,IXTG ,
32 . IGRNOD ,IGRSURF ,IGRSLIN ,
33 . ISKN ,IMERGE ,NMERGE_TOT)
34C--------------------------------------------------------
35C RENITIALISE ELEMENT CONNECTIVITIES AFTER NODE MERGE
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE groupdef_mod
40 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49#include "com04_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER IXS(NIXS,*),IXS10(6,*),IXS16(8,*),IXS20(12,*),IXQ(NIXQ,*),
54 . IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*),
55 . ISKN(LISKN,*),IMERGE(*),NMERGE_TOT
56C-----------------------------------------------
57 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
58 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
59 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,J,K,L,ITYP,NN,TAGNO(NUMNOD),NM
64C=======================================================================
65C-----------------------------------
66C ELEMENTS
67C-----------------------------------
68C
69C--- Solids
70C
71 DO i = 1, numels
72 DO j=2,9
73 DO k = 1,nmerged
74 IF (ixs(j,i) == imerge(k)) ixs(j,i) = imerge(nmerge_tot+k)
75 ENDDO
76 ENDDO
77 ENDDO
78C
79 DO i = 1, numels10
80 DO j=1,6
81 IF(ixs10(j,i)/=0)THEN
82 DO k = 1,nmerged
83 IF(ixs10(j,i) == imerge(k)) ixs10(j,i) = imerge(nmerge_tot+k)
84 ENDDO
85 ENDIF
86 ENDDO
87 ENDDO
88C
89 DO i = 1, numels20
90 DO j=1,12
91 IF(ixs20(j,i)/=0)THEN
92 DO k = 1,nmerged
93 IF(ixs20(j,i) == imerge(k)) ixs20(j,i) = imerge(nmerge_tot+k)
94 ENDDO
95 ENDIF
96 ENDDO
97 ENDDO
98C
99 DO i = 1, numels16
100 DO j=1,8
101 IF(ixs16(j,i)/=0)THEN
102 DO k = 1,nmerged
103 IF(ixs16(j,i) == imerge(k)) ixs16(j,i) = imerge(nmerge_tot+k)
104 ENDDO
105 ENDIF
106 ENDDO
107 ENDDO
108C
109C--- Quads
110C
111C
112 DO i = 1, numelq
113 DO j=2,5
114 DO k = 1,nmerged
115 IF (ixq(j,i) == imerge(k)) ixq(j,i) = imerge(nmerge_tot+k)
116 ENDDO
117 ENDDO
118 ENDDO
119C
120C--- Shells
121C
122 DO i = 1, numelc
123 DO j=2,5
124 DO k = 1,nmerged
125 IF (ixc(j,i) == imerge(k)) ixc(j,i) = imerge(nmerge_tot+k)
126 ENDDO
127 ENDDO
128 ENDDO
129C
130C--- Truss
131C
132 DO i = 1, numelt
133 DO j=2,3
134 DO k = 1,nmerged
135 IF (ixt(j,i) == imerge(k)) ixt(j,i) = imerge(nmerge_tot+k)
136 ENDDO
137 ENDDO
138 ENDDO
139C
140C--- Beams
141C
142 DO i = 1, numelp
143 DO j=2,4
144 DO k = 1,nmerged
145 IF (ixp(j,i) == imerge(k)) ixp(j,i) = imerge(nmerge_tot+k)
146 ENDDO
147 ENDDO
148 ENDDO
149C
150C--- Springs
151C
152 DO i = 1, numelr
153 DO j=2,4
154 IF (ixr(j,i) /= 0) THEN
155 DO k = 1,nmerged
156 IF (ixr(j,i) == imerge(k)) ixr(j,i) = imerge(nmerge_tot+k)
157 ENDDO
158 END IF
159 ENDDO
160 ENDDO
161C
162C--- Triangle Shells
163C
164 DO i = 1, numeltg
165 DO j=2,4
166 DO k = 1,nmerged
167 IF (ixtg(j,i) == imerge(k)) ixtg(j,i) = imerge(nmerge_tot+k)
168 ENDDO
169 ENDDO
170 ENDDO
171C-----------------------------------
172C GROUPS
173C-----------------------------------
174C
175C--- Surfaces
176C
177 DO i=1,nsurf
178 nn = igrsurf(i)%NSEG
179 DO j=1,nn
180 DO l=1,4
181 DO k = 1,nmerged
182 IF (igrsurf(i)%NODES(j,l) == imerge(k))
183 . igrsurf(i)%NODES(j,l) = imerge(nmerge_tot+k)
184 ENDDO
185 ENDDO
186 ENDDO
187 ENDDO
188C
189C--- Lines
190C
191 DO i=1,nslin
192 nn = igrslin(i)%NSEG
193 DO j=1,nn
194 DO l=1,2
195 DO k = 1,nmerged
196 IF (igrslin(i)%NODES(j,l) == imerge(k))
197 . igrslin(i)%NODES(j,l) = imerge(nmerge_tot+k)
198 ENDDO
199 ENDDO
200 ENDDO
201 ENDDO
202C
203C--- Node Groups
204C
205 DO i=1,ngrnod
206 ityp = igrnod(i)%GRTYPE
207 tagno(1:numnod)=0
208 IF (ityp == 0) THEN
209 nn = igrnod(i)%NENTITY
210C--------- Pass 1
211 DO j=1,nn
212 tagno(igrnod(i)%ENTITY(j)) = 1
213 ENDDO
214C--------- Pass 2
215 nm = 0
216 DO j=1,nn
217 DO k = 1,nmerged
218 IF (igrnod(i)%ENTITY(j) == imerge(k)) THEN
219 IF (tagno(imerge(nmerge_tot+k)) == 0) THEN
220C-- node is replaced
221 igrnod(i)%ENTITY(j) = imerge(nmerge_tot+k)
222 tagno(imerge(nmerge_tot+k)) = 1
223 ELSE
224C-- node is removed
225 nm = nm + 1
226 tagno(igrnod(i)%ENTITY(j)) = -1
227 ENDIF
228 ENDIF
229 ENDDO
230 ENDDO
231C--------- Pass 3
232 IF (nm > 0) THEN
233 l = 0
234 DO j=1,nn
235 IF (tagno(igrnod(i)%ENTITY(j)) /= -1) THEN
236 l = l + 1
237 igrnod(i)%ENTITY(l) = igrnod(i)%ENTITY(j)
238 ENDIF
239 ENDDO
240 igrnod(i)%NENTITY = igrnod(i)%NENTITY - nm
241 ENDIF
242C--
243 ENDIF
244 ENDDO
245C-----------------------------------
246C KINEMATIC CONDITIONS
247C-----------------------------------
248C
249C--- Skews
250C
251 DO i=2,numskw
252 DO j=1,3
253 DO k = 1,nmerged
254 IF (iskn(j,i) == imerge(k)) iskn(j,i) = imerge(nmerge_tot+k)
255 ENDDO
256 ENDDO
257 ENDDO
258C-----------------------------------
259 RETURN
260 END SUBROUTINE reconnect
groupdef_mod
Definition groupdef_mod.F:668
reconnect
subroutine reconnect(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, igrnod, igrsurf, igrslin, iskn, imerge, nmerge_tot)
Definition reconnect.F:34