OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
anioffc_ply.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "scr17_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine anioffc_ply (iply, nel_ply, elbuf_tab, iparg, ioff, el2fa, nbf, iadd, nbf_l, nbpart, iadg, nodglob, ipart, ipartc, iparttg, nbf_pxfemg, ipm, igeo, ixc, stack)

Function/Subroutine Documentation

◆ anioffc_ply()

subroutine anioffc_ply ( integer iply,
integer nel_ply,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(*) ioff,
integer, dimension(*) el2fa,
integer nbf,
integer, dimension(*) iadd,
integer nbf_l,
integer nbpart,
integer, dimension(nspmd,*) iadg,
integer, dimension(*) nodglob,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer nbf_pxfemg,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixc,*) ixc,
type (stack_ply) stack )

Definition at line 37 of file anioffc_ply.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE elbufdef_mod
46 USE plyxfem_mod
47 USE stack_mod
48 USE my_alloc_mod
49 use element_mod , only : nixc
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "param_c.inc"
61#include "remesh_c.inc"
62#include "scr17_c.inc"
63#include "task_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER IPARG(NPARG,*),EL2FA(*),NBF,IOFF(*),
68 . IADD(*),NBF_L,NBPART, IADG(NSPMD,*),NODGLOB(*),
69 . IPART(LIPART1,*), IPARTC(*), IPARTTG(*)
70 INTEGER IPLY,NEL_PLY,PLYS,NBF_PXFEMG,IXC(NIXC,*),IPM(NPROPMI,*),
71 . IGEO(NPROPGI,*)
72 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
73 TYPE (STACK_PLY) :: STACK
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, NPT,
78 . N, J, LLT, MLW, IP,
79 .
80 . N_FA, IHBE, ISTRAIN, IEXPAN,ISHPLYXFEM,NELXFE,IE,
81 . PLYELEMS(NUMELC),IPT,ELC,MPT,NGL(MVSIZ),ISUBSTACK,IPMAT_IPLY,
82 . IPMAT, IPPID
83
84 INTEGER RBUF,NEL3,NEL5,NEL8,NPTM,
85 . NPG,PID(MVSIZ),MATLY,NUVARR,NUVARD,NBM_S,
86 . IFAILURE,NPTR,NPTS,IS,IR,OFFIPLY
87 INTEGER,DIMENSION(:),ALLOCATABLE::IOFFBUF
88 TYPE(G_BUFEL_) ,POINTER :: GBUF
89 TYPE(BUF_LAY_) ,POINTER :: BUFLY
90 TYPE(L_BUFEL_) ,POINTER :: LBUF
91C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
92 CALL my_alloc(ioffbuf,nbf_l)
93 npg = 4
94 ioffbuf = -1
95 DO plys = 1,nplypart
96 iply = indx_ply(plys)
97
98C-----------------------------------------------
99C PLY ELEMS INIT
100C-----------------------------------------------
101 plyelems=0
102 DO i=1,plyshell(iply)%PLYNUMSHELL
103 ipt = plyshell(iply)%SHELLIPT(i)
104 elc = plyshell(iply)%SHID(i)
105 plyelems(elc)=ipt
106 ENDDO
107
108C-----------------------------------------------
109C
110cc NN1 = EPLYXFE*(IPLY - 1)
111
112C-----------------------------------------------
113C
114 nelxfe = 0
115 ie = 0
116 DO ng=1,ngroup
117 mlw =iparg(1,ng)
118 nel =iparg(2,ng)
119 ity =iparg(5,ng)
120 nft =iparg(3,ng)
121 iad =iparg(4,ng)
122 mpt = iparg(6,ng)
123 ishplyxfem = iparg(50,ng)
124 isubstack = iparg(71,ng)
125 lft=1
126 llt=nel
127C-----------------------------------------------
128C COQUES 4 N
129C-----------------------------------------------
130 IF(ishplyxfem > 0 ) THEN
131C for batoz shell
132 nptr = elbuf_tab(ng)%NPTR
133 npts = elbuf_tab(ng)%NPTS
134C
135 gbuf => elbuf_tab(ng)%GBUF
136 bufly => elbuf_tab(ng)%BUFLY(ipt) ! Ipt is no right
137 IF (ity == 3) THEN
138 ihbe = iparg(23,ng)
139 npt =iparg(6,ng)
140 istrain=iparg(44,ng)
141 iexpan=iparg(49,ng)
142 ifailure = iparg(43,ng)
143 n_fa =nel_ply
144 nelxfe = nelxfe + nel
145
146 DO i=1,nel
147 pid(i) = ixc(6,nft + i)
148 ngl(i) = ixc(7,nft + i)
149 ENDDO
150C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
151 IF (ihbe >= 11.AND.ihbe <= 19)THEN
152 nel3 = nel*3
153 nel5 = nel*5
154 nel8 = nel*8
155 nptm = max(1,mpt)
156 IF (mpt >= one) THEN
157 ENDIF
158 nbm_s = 6*nel*mpt+nel
159 nuvarr = zero
160 nuvard = zero
161C
162 ippid = 2
163 ipmat = ippid + npt ! layer material address ( NLAY = NPT )
164 ipmat_iply = ipmat + npt
165 DO j= 1,mpt-1
166 DO i=1,nel
167 matly = stack%IGEO(ipmat + j,isubstack)
168 nuvarr = max(nuvarr,ipm(221,matly))
169 matly = stack%IGEO(ipmat_iply + j,isubstack)
170 nuvard = max(nuvard, ipm(221,matly))
171 ENDDO
172 ENDDO
173 DO i=1,nel
174 matly = stack%IGEO(ipmat + j,isubstack)
175 nuvarr = max(nuvarr,ipm(221,matly))
176 ENDDO
177 ENDIF
178 nbm_s = nbm_s + nel*mpt*nuvarr
179C-----------------------------------------------
180C COQUES 3 N
181C-----------------------------------------------
182 ELSEIF(ity==7)THEN
183C it's not available for T3
184 ENDIF
185C-----------------------------------------------
186 IF(ity == 3)THEN
187 IF(mlw == 0 .OR. mlw == 13)THEN
188C-----------------------------------------------
189C DUMMY ELEMENTS
190C-----------------------------------------------
191 DO i=lft,llt
192 n = i + nft
193 IF(plyelems(n) > 0) THEN
194 ie = ie + 1
195 ioff(el2fa(n_fa+ie)) = 1
196 ENDIF
197 ENDDO
198 ELSE
199C-----------------------------------------------
200C OFF Is Only for batoz for now. Because Plyxfem is available only with Bato z shell
201C-----------------------------------------------
202 IF(nadmesh==0.OR.(ity/=3.AND.ity/=7))THEN
203 DO i=lft,llt
204 n = i + nft
205 ipt = plyelems(n)
206 IF(plyelems(n) > 0) THEN
207 ie = ie +1
208 ioff(el2fa(n_fa+ie)) = 1
209 DO is = 1,npts
210 DO ir = 1,nptr
211 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(ir,is,1)
212 offiply = nint(min(gbuf%OFF(i),lbuf%OFF(i),one))
213 ioff(el2fa(n_fa+ie)) = min(ioff(el2fa(n_fa+ie)),offiply)
214 ENDDO
215 ENDDO
216 ENDIF
217 ENDDO
218 ELSE
219 DO i=lft,llt
220 n = i + nft
221 ipt = plyelems(n)
222 IF(plyelems(n) > 0) THEN
223 ip=ipartc(nft+i)
224 ie = ie + 1
225 ioff(el2fa(n_fa+ie)) = 1
226 IF(ipart(10,ip)>0)THEN
227 DO is = 1,npts
228 DO ir = 1,nptr
229 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(ir,is,1)
230 offiply = nint(min(gbuf%OFF(i),lbuf%OFF(i),one))
231 ioff(el2fa(n_fa+ie))=min(ioff(el2fa(n_fa+ie)),offiply)
232 ENDDO
233 ENDDO
234 ELSE
235 DO is = 1,npts
236 DO ir = 1,nptr
237 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(ir,is,1)
238 offiply = nint(min(gbuf%OFF(i),lbuf%OFF(i),one))
239 ioff(el2fa(n_fa+ie)) =min(ioff(el2fa(n_fa+ie)),offiply)
240 ENDDO
241 ENDDO
242 END IF
243 ENDIF
244 ENDDO
245 ENDIF
246 ENDIF
247 ENDIF
248C
249 ENDIF
250C-----------------------------------------------
251 ENDDO
252C-----------------------------------------------
253 iadd(iply) = nel_ply + ie
254 nel_ply = nel_ply + plyshell(iply)%PLYNUMSHELL
255 ENDDO
256C
257 IF (nspmd==1)THEN
258 CALL write_c_c(ioff,nbf)
259 ELSE
260
261 DO i = 1, nbf_l
262 ioffbuf(i) = ioff(i)
263 ENDDO
264
265 IF (ispmd==0) THEN
266 rbuf = nbf_pxfemg
267 CALL spmd_iget_partn(1,nbf_l,ioffbuf,nplypart,iadg,rbuf,2)
268 ELSE
269 rbuf = 1
270 CALL spmd_iget_partn(1,nbf_l,ioffbuf,nplypart,iadg,rbuf,2)
271 END IF
272 ENDIF
273 DEALLOCATE(ioffbuf)
274 RETURN
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::indx_ply
integer, dimension(:), allocatable indx_ply
Definition plyxfem_mod.F:60
plyxfem_mod::nplypart
integer nplypart
Definition plyxfem_mod.F:59
plyxfem_mod::plyshell
type(plyshells), dimension(:), allocatable plyshell
Definition plyxfem_mod.F:56
stack_mod
Definition stack_mod.F:75
spmd_iget_partn
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
Definition spmd_iget_partn.F:50
write_c_c
void write_c_c(int *w, int *len)
Definition write_routines.c:591