OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dmasani6.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!|| dmasanis ../engine/source/output/anim/generate/dmasani6.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| initbuf_mod ../engine/share/resol/initbuf.F
33!||====================================================================
34 SUBROUTINE dmasanis(ELBUF_TAB,X ,D ,GEO ,IPARG ,
35 2 IXS ,MAS ,PM ,EL2FA ,NBF ,
36 3 IPART ,IPARTSP ,ISPH3D )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE initbuf_mod
41 USE elbufdef_mod
42 use element_mod , only : nixs
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "vect01_c.inc"
51#include "mvsiz_p.inc"
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "sphcom.inc"
55#include "scr17_c.inc"
56#include "param_c.inc"
57#include "task_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61C REAL
62 my_real
63 . mas(*) ,pm(npropm,*),geo(npropg,*),x(3,*),d(3,*)
64 INTEGER IPARG(NPARG,*),IXS(NIXS,*),EL2FA(*),NBF,IPART(LIPART1,*),
65 . IPARTSP(*),ISPH3D
66 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70C REAL
71 my_real
72 . evar(mvsiz),
73 . off, p, vonm2, vonm, s1, s2, s12, s3, VALUE,thk0,a0,al0,
74 . rho0,xx1,xx2,xx3,yy1,yy2,yy3,zz1,zz2,zz3
75 INTEGER I, NG, NEL,
76 . IADD, N, J, MLW,
77 . istrain,nn, k1, k2,jturb,mt,imid, ialel,ipid,
78 . n1,n2,n3,n4,
79 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,
80 . offset,nel_old,ity_old,nft_fa,n_fa,
81 . inod, isolnod, iprt
82 TYPE(g_bufel_) ,POINTER :: GBUF
83C=======================================================================
84 nn1 = 1
85 nn2 = 1
86 nn3 = nn2 + numels
87 nn4 = nn3 + isph3d*(numsph+maxpjet)
88C-----------------------------------------------
89C face ext
90C-----------------------------------------------
91 nel_old = 0
92 ity_old = 0
93 DO 490 ng=1,ngroup
94 CALL initbuf(iparg ,ng ,
95 2 mlw ,nel ,nft ,iad ,ity ,
96 3 npt ,jale ,ismstr ,jeul ,jtur ,
97 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
98 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
99 6 irep ,iint ,igtyp ,israt ,isrot ,
100 7 icsen ,isorth ,isorthg ,ifailure,jsms )
101 isolnod = iparg(28,ng)
102 IF (ispmd == 0) THEN
103 IF (ity/=ity_old) THEN
104 nel_old = 0
105 ity_old= ity
106 ENDIF
107 nft_fa = nel_old
108 nel_old = nel_old + nel
109 ENDIF
110 DO offset = 0,nel-1,nvsiz
111 nft =iparg(3,ng) + offset
112 iad =iparg(4,ng)
113 lft=1
114 llt=min(nvsiz,nel-offset)
115 IF (ispmd == 0) THEN
116 nft_fa = nel_old - nel + offset
117 ELSE
118 nft_fa = nft
119 ENDIF
120C-----------------------------------------------
121C SOLIDE
122C-----------------------------------------------
123 IF(ity == 1)THEN
124 gbuf => elbuf_tab(ng)%GBUF
125 ialel=iparg(7,ng)+iparg(11,ng)
126 DO 130 i=lft,llt
127 n = i + nft
128 n_fa = i + nft_fa
129 IF(el2fa(nn2+n_fa)/=0)THEN
130 IF (mlw == 0 .or. mlw == 13 .or. igtyp == 0) THEN
131 VALUE = zero
132 ELSEIF(ialel == 0)THEN
133 mt=ixs(1,n)
134 VALUE=pm(89,mt)*gbuf%VOL(i)
135 ELSE
136 off = min(gbuf%OFF(i),one)
137 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
138 ENDIF
139 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 )
140 . VALUE = VALUE * gbuf%FILL(i)
141 IF (isolnod == 16) THEN
142 VALUE = fourth*VALUE
143 mas(el2fa(nn2+n_fa)) = VALUE
144 mas(el2fa(nn2+n_fa)+1) = VALUE
145 mas(el2fa(nn2+n_fa)+2) = VALUE
146 mas(el2fa(nn2+n_fa)+3) = VALUE
147 ELSE
148 mas(el2fa(nn2+n_fa)) = VALUE
149 ENDIF
150 ENDIF
151 130 CONTINUE
152C
153 ELSEIF(isph3d == 1 .AND. ity == 51)THEN
154C-----------------------------------------------
155C TETRAS SPH.
156C-----------------------------------------------
157 gbuf => elbuf_tab(ng)%GBUF
158 ialel=iparg(7,ng)+iparg(11,ng)
159 DO 140 i=lft,llt
160 n = i + nft
161 n_fa = i + nft_fa
162 IF(el2fa(nn3+n_fa)/=0)THEN
163 IF(ialel == 0)THEN
164 iprt=ipartsp(n)
165 mt =ipart(1,iprt)
166 VALUE=pm(89,mt)*gbuf%VOL(i)
167 ELSE
168 off = min(gbuf%OFF(i),one)
169 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
170 ENDIF
171 mas(el2fa(nn3+n_fa)) = VALUE
172 ENDIF
173 140 CONTINUE
174C
175 ELSE
176 ENDIF
177C-----------------------------------------------
178C end of loop over offsets
179C-----------------------------------------------
180 END DO
181 490 CONTINUE
182C-----------------------------------------------
183C
184 RETURN
185 END
my_real
#define my_real
Definition cppsort.cpp:32
dmasanis
subroutine dmasanis(elbuf_tab, x, d, geo, iparg, ixs, mas, pm, el2fa, nbf, ipart, ipartsp, isph3d)
Definition dmasani6.F:37
min
#define min(a, b)
Definition macros.h:20
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261