OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbypid.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fxbypid (output, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, fxbipm, fxbnod, onof, itag, onfelt, elbuf_str)

Function/Subroutine Documentation

◆ fxbypid()

subroutine fxbypid ( type(output_), intent(inout) output,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) fxbipm,
integer, dimension(*) fxbnod,
integer onof,
integer, dimension(*) itag,
integer onfelt,
type(elbuf_struct_), dimension(ngroup), target elbuf_str )

Definition at line 37 of file fxbypid.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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