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

Go to the source code of this file.

Functions/Subroutines

subroutine dmasanic (elbuf_tab, x, d, geo, iparg, ixq, ixc, ixtg, mas, pm, el2fa, nbf, igeo, stack)

Function/Subroutine Documentation

◆ dmasanic()

subroutine dmasanic ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
x,
d,
geo,
integer, dimension(nparg,*) iparg,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
mas,
pm,
integer, dimension(*) el2fa,
integer nbf,
integer, dimension(npropgi,*) igeo,
type (stack_ply) stack )

Definition at line 32 of file dmasanic.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE elbufdef_mod
39 USE stack_mod
40 use element_mod , only : nixq,nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51#include "task_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55C REAL
56 my_real
57 . mas(*) ,pm(npropm,*),geo(npropg,*),x(3,*),
58 . d(3,*)
59 INTEGER IPARG(NPARG,*),IXC(NIXC,*),IXTG(NIXTG,*),
60 . IXQ(NIXQ,*),EL2FA(*),NBF,IGEO(NPROPGI,*)
61 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
62 TYPE (STACK_PLY) :: STACK
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66C REAL
67 my_real
68 . off, p, vonm2, vonm, s1, s2, s12, s3, VALUE,thk0,a0,al0,
69 . rho0,xx1,xx2,xx3,yy1,yy2,yy3,zz1,zz2,zz3
70 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, NPT,
71 . IADD, N, J, LLT, MLW,
72 . ISTRAIN,NN, K1, K2,JTURB,MT,JALE, IMID, IALEL,IPID,
73 . N1,N2,N3,N4,
74 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
75 . OFFSET,NEL_OLD,ITY_OLD,NFT_FA,N_FA
76 INTEGER ISUBSTACK, IGTYP
77
78 TYPE(G_BUFEL_) ,POINTER :: GBUF
79C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
80 nn1 = 1
81 nn2 = 1
82 nn3 = 1
83 nn4 = nn3 + numelq
84 nn5 = nn4 + numelc
85 nn6 = nn5 + numeltg
86 nn7 = nn6
87 nn8 = nn7
88 nn9 = nn8
89 nn10= nn9
90C-----------------------------------------------
91C
92 nel_old = 0
93 ity_old = 0
94 DO 490 ng=1,ngroup
95 gbuf => elbuf_tab(ng)%GBUF
96 nel =iparg(2,ng)
97 ity =iparg(5,ng)
98 npt =iabs(iparg(6,ng))
99 IF (ispmd==0) THEN
100 IF (ity/=ity_old) THEN
101 nel_old = 0
102 ity_old= ity
103 ENDIF
104 nft_fa = nel_old
105 nel_old = nel_old + nel
106 ENDIF
107 nft =iparg(3,ng)
108 iad =iparg(4,ng)
109 lft=1
110 llt=nel
111 IF (ispmd==0) THEN
112 nft_fa = nel_old - nel
113 ELSE
114 nft_fa = nft
115 ENDIF
116C-----------------------------------------------
117C QUAD
118C-----------------------------------------------
119 IF(ity==2)THEN
120 ialel=(iparg(7,ng)+iparg(11,ng))
121C
122 DO i=lft,llt
123 n = i + nft
124 n_fa = i + nft_fa
125 IF(ialel==0)THEN
126 mt=ixq(1,n)
127 VALUE=pm(89,mt)*gbuf%VOL(i)
128 ELSE
129 off = min(gbuf%OFF(i),one)
130 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
131 ENDIF
132 mas(el2fa(nn3+n_fa)) = VALUE
133 ENDDO
134C-----------------------------------------------
135C COQUES 4 N
136C-----------------------------------------------
137 ELSEIF(ity==3)THEN
138C
139 isubstack=iparg(71,ng)
140 igtyp = iparg(38,ng)
141 IF(igtyp /= 17 . and. igtyp /= 51 .AND. igtyp /= 52) THEN
142 DO i=lft,llt
143 n = i + nft
144 n_fa = i + nft_fa
145 rho0 = pm(1,ixc(1,n))
146 thk0 = geo(1,ixc(6,n))
147 n1 = ixc(2,n)
148 n2 = ixc(3,n)
149 n3 = ixc(4,n)
150 n4 = ixc(5,n)
151 xx1 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
152 yy1 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
153 zz1 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
154 xx2 = x(1,n4)-d(1,n4)-x(1,n2)+d(1,n2)
155 yy2 = x(2,n4)-d(2,n4)-x(2,n2)+d(2,n2)
156 zz2 = x(3,n4)-d(3,n4)-x(3,n2)+d(3,n2)
157 xx3 = yy1*zz2 - zz1*yy2
158 yy3 = zz1*xx2 - xx1*zz2
159 zz3 = xx1*yy2 - yy1*xx2
160 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
161 mas(el2fa(nn4+n_fa)) = rho0*thk0*a0
162 ENDDO
163 ELSE
164!! IIGEO = 40 + 5*(ISUBSTACK - 1)
165!! IADR = IGEO(IIGEO + 4,IXC(6,NFT + 1))
166!! NTHK = IADR + 3*NPT
167 DO i=lft,llt
168 n = i + nft
169 n_fa = i + nft_fa
170 rho0 = pm(1,ixc(1,n))
171 thk0 = stack%GEO(1,isubstack)
172 n1 = ixc(2,n)
173 n2 = ixc(3,n)
174 n3 = ixc(4,n)
175 n4 = ixc(5,n)
176 xx1 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
177 yy1 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
178 zz1 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
179 xx2 = x(1,n4)-d(1,n4)-x(1,n2)+d(1,n2)
180 yy2 = x(2,n4)-d(2,n4)-x(2,n2)+d(2,n2)
181 zz2 = x(3,n4)-d(3,n4)-x(3,n2)+d(3,n2)
182 xx3 = yy1*zz2 - zz1*yy2
183 yy3 = zz1*xx2 - xx1*zz2
184 zz3 = xx1*yy2 - yy1*xx2
185 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
186 mas(el2fa(nn4+n_fa)) = rho0*thk0*a0
187 ENDDO
188 ENDIF
189C-----------------------------------------------
190C COQUES 3 N
191C-----------------------------------------------
192 ELSEIF(ity==7)THEN
193C
194 isubstack=iparg(71,ng)
195 igtyp = iparg(38,ng)
196 IF(igtyp /= 17 . and. igtyp /= 51 .AND. igtyp /= 52) THEN
197 DO i=lft,llt
198 n = i + nft
199 n_fa = i + nft_fa
200 rho0 = pm(1,ixtg(1,n))
201 thk0 = geo(1,ixtg(5,n))
202 n1 = ixtg(2,n)
203 n2 = ixtg(3,n)
204 n3 = ixtg(4,n)
205 xx1 = x(1,n2)-d(1,n2)-x(1,n1)+d(1,n1)
206 yy1 = x(2,n2)-d(2,n2)-x(2,n1)+d(2,n1)
207 zz1 = x(3,n2)-d(3,n2)-x(3,n1)+d(3,n1)
208 xx2 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
209 yy2 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
210 zz2 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
211 xx3 = yy1*zz2 - zz1*yy2
212 yy3 = zz1*xx2 - xx1*zz2
213 zz3 = xx1*yy2 - yy1*xx2
214 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
215 mas(el2fa(nn5+n_fa)) = rho0*thk0*a0
216 ENDDO
217 ELSE
218 n = 1 + nft
219!! IIGEO = 40 + 5*(ISUBSTACK - 1)
220!! IADR = IGEO(IIGEO + 4,IXC(6,N))
221!! NTHK = IADR + 3*NPT
222 DO i=lft,llt
223 n = i + nft
224 n_fa = i + nft_fa
225 rho0 = pm(1,ixtg(1,n))
226 thk0 = stack%GEO(1,isubstack)
227 n1 = ixtg(2,n)
228 n2 = ixtg(3,n)
229 n3 = ixtg(4,n)
230 xx1 = x(1,n2)-d(1,n2)-x(1,n1)+d(1,n1)
231 yy1 = x(2,n2)-d(2,n2)-x(2,n1)+d(2,n1)
232 zz1 = x(3,n2)-d(3,n2)-x(3,n1)+d(3,n1)
233 xx2 = x(1,n3)-d(1,n3)-x(1,n1)+d(1,n1)
234 yy2 = x(2,n3)-d(2,n3)-x(2,n1)+d(2,n1)
235 zz2 = x(3,n3)-d(3,n3)-x(3,n1)+d(3,n1)
236 xx3 = yy1*zz2 - zz1*yy2
237 yy3 = zz1*xx2 - xx1*zz2
238 zz3 = xx1*yy2 - yy1*xx2
239 a0 = half*sqrt(xx3*xx3 + yy3*yy3 + zz3*zz3)
240 mas(el2fa(nn5+n_fa)) = rho0*thk0*a0
241 ENDDO
242 ENDIF
243C
244 ELSE
245 ENDIF
246C-----------------------------------------------
247C end of loop over offsets
248C-----------------------------------------------
249 490 CONTINUE
250C-----------------------------------------------
251C
252 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
stack_mod
Definition stack_mod.F:75