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