OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbypid.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!|| fxbypid ../engine/source/constraints/fxbody/fxbypid.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| spmd_chkw ../engine/source/mpi/generic/spmd_chkw.F
29!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
30!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
31!|| spmd_wiout ../engine/source/mpi/generic/spmd_wiout.F
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
34!||====================================================================
35 SUBROUTINE fxbypid(IPARG , IXS , IXQ , IXC ,
36 . IXT , IXP , IXR , IXTG , FXBIPM ,
37 . FXBNOD, ONOF , ITAG , ONFELT, ELBUF_STR )
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "units_c.inc"
53#include "task_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER IPARG(NPARG,*),IXS(NIXS,*), IXQ(NIXQ,*),IXC(NIXC,*),
58 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*),
59 . fxbipm(*),fxbnod(*),onof,itag(*),onfelt
60 TYPE(elbuf_struct_),TARGET ,DIMENSION(NGROUP) :: ELBUF_STR
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER NSN,NG,MLW,ITY,NEL,NFT,IAD,I,II,NALL,IGOF,ISHFT,IWIOUT
65 my_real,
66 . DIMENSION(:), POINTER :: offg
67C-----------------------------------------------
68C E x t e r n a l F u n c t i o n s
69C-----------------------------------------------
70C
71 IF (ispmd == 0) WRITE(iout,*) ' BEGINNING FXBYPID'
72 IF (onof == 0) THEN
73C-----------------------
74C Flexible body de-activation (to be done)
75C-----------------------
76 ELSEIF (onof == 1) THEN
77C-----------------------
78C Flexible body activation
79C-----------------------
80 ENDIF
81C
82 IF(onfelt == 0.OR.onfelt == 1)THEN
83 nsn=fxbipm(3)
84C-----------------------
85C Tag secondary nodes
86C-----------------------
87 DO i=1,numnod
88 itag(i)=0
89 ENDDO
90 DO i=1,nsn
91 itag(fxbnod(i))=1
92 ENDDO
93C-----------------------
94C Change OFF to -OFF
95C-----------------------
96 DO ng=1,ngroup
97 mlw=iparg(1,ng)
98 ity=iparg(5,ng)
99 nel=iparg(2,ng)
100 nft=iparg(3,ng)
101 iad=iparg(4,ng) - 1
102C-----------------------
103C 1. Solid elements
104C-----------------------
105 IF (ity == 1 .AND. mlw /= 0) THEN ! loi0, no off
106 offg => elbuf_str(ng)%GBUF%OFF
107 DO i=1,nel
108 ii=i+nft
109 nall = itag(ixs(2,ii)) * itag(ixs(3,ii)) *
110 + itag(ixs(4,ii)) * itag(ixs(5,ii)) *
111 + itag(ixs(6,ii)) * itag(ixs(7,ii)) *
112 + itag(ixs(8,ii)) * itag(ixs(9,ii))
113 IF(nall /= 0)THEN
114 IF(onfelt == 1)THEN
115 offg(i)= abs(offg(i))
116 WRITE(iout,*)' BRICK ACTIVATION:',ixs(11,ii)
117 ELSEIF(onfelt == 0)THEN
118 offg(i) = -abs(offg(i))
119 WRITE(iout,*)' BRICK DEACTIVATION:',ixs(11,ii)
120 ENDIF
121 ENDIF
122 ENDDO
123C----------------------------------------
124C Test group elimination
125C----------------------------------------
126 igof = 1
127 DO i = 1,nel
128 IF (offg(i) > zero) igof=0
129 ENDDO
130 iparg(8,ng) = igof
131C-------------------------------
132C 3. 4-nodes shell elements
133C-------------------------------
134 ELSEIF(ity == 3 .and. mlw /= 0)THEN ! loi0, no off
135 offg => elbuf_str(ng)%GBUF%OFF
136 DO i=1,nel
137 ii=i+nft
138 nall = itag(ixc(2,ii)) * itag(ixc(3,ii)) *
139 + itag(ixc(4,ii)) * itag(ixc(5,ii))
140 IF (nall /= 0) THEN
141 IF (onfelt == 1) THEN
142 offg(i) = abs(offg(i))
143 WRITE(iout,*)' SHELL ACTIVATION:',ixc(7,ii)
144 ELSEIF (onfelt == 0) THEN
145 offg(i) = -abs(offg(i))
146 WRITE(iout,*)' SHELL DEACTIVATION:',ixc(7,ii)
147 ENDIF
148 ENDIF
149 ENDDO
150C----------------------------------------
151C Test group elimination
152C----------------------------------------
153 igof = 1
154 DO i = 1,nel
155 IF (offg(i) > zero) igof=0
156 ENDDO
157 iparg(8,ng) = igof
158C-----------------------
159C 4. Truss elements
160C-----------------------
161 ELSEIF(ity == 4)THEN
162 offg => elbuf_str(ng)%GBUF%OFF
163 DO i=1,nel
164 ii=i+nft
165 nall = itag(ixt(2,ii)) * itag(ixt(3,ii))
166 IF(nall /= 0)THEN
167 IF(onfelt == 1)THEN
168 offg(i) = one
169 WRITE(iout,*)' TRUSS ACTIVATION:',ixt(5,ii)
170 ELSEIF(onfelt == 0)THEN
171 offg(i) = zero
172 WRITE(iout,*)' TRUSS DEACTIVATION:',ixt(5,ii)
173 ENDIF
174 ENDIF
175 ENDDO
176C----------------------------------------
177C Test group elimination
178C----------------------------------------
179 igof = 1
180 DO i = 1,nel
181 IF (offg(i) /= zero) igof=0
182 ENDDO
183 iparg(8,ng) = igof
184C-----------------------
185C 5. Beam elements
186C-----------------------
187 ELSEIF(ity == 5)THEN
188 offg => elbuf_str(ng)%GBUF%OFF
189 DO i=1,nel
190 ii=i+nft
191 nall = itag(ixp(2,ii)) * itag(ixp(3,ii))
192 IF(nall /= 0)THEN
193 IF(onfelt == 1)THEN
194 offg(i)= abs(offg(i))
195 WRITE(iout,*)' BEAM ACTIVATION:',ixp(6,ii)
196 ELSEIF(onfelt == 0)THEN
197 offg(i)= -abs(offg(i))
198 WRITE(iout,*)' BEAM DEACTIVATION:',ixp(6,ii)
199 ENDIF
200 ENDIF
201 ENDDO
202C----------------------------------------
203C Test group elimination
204C----------------------------------------
205 igof = 1
206 DO i = 1,nel
207 IF(offg(i)>zero) igof=0
208 ENDDO
209 iparg(8,ng) = igof
210C-----------------------
211C 6. Spring elements
212C-----------------------
213 ELSEIF(ity == 6.AND.mlw /= 3)THEN
214 offg => elbuf_str(ng)%GBUF%OFF
215 DO i=1,nel
216 ii=i+nft
217 nall = itag(ixr(2,ii)) * itag(ixr(3,ii))
218 IF(nall /= 0)THEN
219 IF(onfelt == 1)THEN
220 offg(i)= one
221 WRITE(iout,*)' SPRING ACTIVATION:',ixr(nixr,ii)
222 ELSEIF(onfelt == 0)THEN
223 offg(i)= zero
224 WRITE(iout,*)' SPRING DEACTIVATION:',ixr(nixr,ii)
225 ENDIF
226 ENDIF
227 ENDDO
228C----------------------------------------
229C Test group elimination
230C----------------------------------------
231 igof = 1
232 DO i = 1,nel
233 IF(offg(i) /= zero) igof=0
234 ENDDO
235 iparg(8,ng) = igof
236C------------------------------
237C 7. 3-nodes shell elements
238C------------------------------
239 ELSEIF(ity == 7 .and. mlw /= 0)THEN ! loi0, pas de off
240 offg => elbuf_str(ng)%GBUF%OFF
241 DO i=1,nel
242 ii=i+nft
243 nall = itag(ixtg(2,ii)) * itag(ixtg(3,ii)) *
244 + itag(ixtg(4,ii))
245 IF(nall /= 0)THEN
246 IF (onfelt == 1) THEN
247 offg(i) = abs(offg(i))
248 WRITE(iout,*)' SH_3N ACTIVATION:',ixtg(6,ii)
249 ELSEIF (onfelt == 0) THEN
250 offg(i) = -abs(offg(i))
251 WRITE(iout,*)' SH_3N DEACTIVATION:',ixtg(6,ii)
252 ENDIF
253 ENDIF
254 ENDDO
255C----------------------------------------
256C Test group elimination
257C----------------------------------------
258 igof = 1
259 DO i = 1,nel
260 IF (offg(i) > zero) igof=0
261 ENDDO
262 iparg(8,ng) = igof
263C----------------------------------------
264 ENDIF
265 ENDDO
266 IF(nspmd>1) THEN
267C
268C Recovery of active or de-activated elements in the right order
269 iwiout = 0
270 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
271 CALL spmd_glob_isum9(iwiout,1)
272 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
273 IF (iwiout>0) THEN
274 CALL spmd_wiout(iout,iwiout)
275 iwiout = 0
276 ENDIF
277 ENDIF
278C
279 ENDIF
280 IF (ispmd == 0) WRITE(iout,*) ' END FXBYPID'
281c-----------
282 RETURN
283 END SUBROUTINE fxbypid
284
fxbypid
subroutine fxbypid(iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, fxbipm, fxbnod, onof, itag, onfelt, elbuf_str)
Definition fxbypid.F:38
spmd_chkw
subroutine spmd_chkw(iwiout, iout)
Definition spmd_chkw.F:38
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523
spmd_wiout
subroutine spmd_wiout(iout, iwiout)
Definition spmd_wiout.F:40