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 (iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, fxbipm, fxbnod, onof, itag, onfelt, elbuf_str)

Function/Subroutine Documentation

◆ fxbypid()

subroutine fxbypid ( 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 35 of file fxbypid.F.

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.AND. ELSEIF(ITY == 6MLW /= 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.and. ELSEIF(ITY == 7 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
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:523
spmd_wiout
subroutine spmd_wiout(iout, iwiout)
Definition spmd_wiout.F:40