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