OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dmasanis.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 ../starter/source/output/anim/dmasanis.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../starter/source/output/anim/initbuf.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE dmasanis(ELBUF_TAB,IPARG ,
32 2 IXS ,MAS ,PM ,EL2FA ,NBF ,
33 3 IPART ,IPARTSP ,ISPH3D )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE elbufdef_mod
38 use element_mod , only : nixs
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "vect01_c.inc"
47#include "mvsiz_p.inc"
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "scr17_c.inc"
51#include "param_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,*)
58 INTEGER IPARG(NPARG,*),IXS(NIXS,*),EL2FA(*),NBF,IPART(LIPART1,*),
59 . IPARTSP(*),ISPH3D
60 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 my_real
65 . evar(mvsiz),
66 . off,VALUE
67 INTEGER I, NG, NEL, ISS, ISC,N, J, MLW,
68 . NN, K1, K2,JTURB,MT, IALEL,IPID,
69 . n1,n2,n3,n4,nn1,nn2,nn3,
70 . offset,nft_fa,n_fa,
71 . inod, isolnod, iprt,
72 . jhbe, jivf, jclose, jplasol, irep, igtyp,
73 . icsen, isorthg, ifailure, iint
74 TYPE(g_bufel_) ,POINTER :: GBUF
75 REAL R4
76C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
77 nn1 = 1
78 nn2 = 1
79 nn3 = nn2 + numels
80C-----------------------------------------------
81C face ext
82C-----------------------------------------------
83 DO 490 ng=1,ngroup
84 CALL initbuf (iparg ,ng ,
85 2 mlw ,nel ,nft ,iad ,ity ,
86 3 npt ,jale ,ismstr ,jeul ,jtur ,
87 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
88 5 jpor ,jcvt ,jclose ,jplasol ,
89 6 irep ,iint ,igtyp ,israt ,isrot ,
90 7 icsen ,isorth ,isorthg ,ifailure)
91 isolnod = iparg(28,ng)
92 DO offset = 0,nel-1,nvsiz
93 nft =iparg(3,ng) + offset
94 iad =iparg(4,ng)
95 lft=1
96 llt=min(nvsiz,nel-offset)
97 nft_fa = nft
98C-----------------------------------------------
99C SOLIDE
100C-----------------------------------------------
101 IF (ity==1 .and. mlw > 0) THEN
102 ialel=iparg(7,ng)+iparg(11,ng)
103 gbuf => elbuf_tab(ng)%GBUF
104 DO 130 i=lft,llt
105 n = i + nft
106 n_fa = i + nft_fa
107 IF(el2fa(nn2+n_fa)/=0)THEN
108 IF(ialel==0)THEN
109 mt=ixs(1,n)
110 VALUE=pm(89,mt)*gbuf%VOL(i)
111 ELSE
112 off = min(gbuf%OFF(i),one)
113 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
114 ENDIF
115 IF(isolnod==16)THEN
116 VALUE = fourth*VALUE
117 mas(el2fa(nn2+n_fa)) = VALUE
118 mas(el2fa(nn2+n_fa)+1) = VALUE
119 mas(el2fa(nn2+n_fa)+2) = VALUE
120 mas(el2fa(nn2+n_fa)+3) = VALUE
121 ELSE
122 mas(el2fa(nn2+n_fa)) = VALUE
123 ENDIF
124 ENDIF
125 130 CONTINUE
126C
127 ELSEIF(isph3d==1.AND.ity==51.and.mlw > 0)THEN
128C-----------------------------------------------
129C TETRAS SPH.
130C-----------------------------------------------
131 gbuf => elbuf_tab(ng)%GBUF
132 ialel=iparg(7,ng)+iparg(11,ng)
133 DO 140 i=lft,llt
134 n = i + nft
135 n_fa = i + nft_fa
136 IF(el2fa(nn3+n_fa)/=0)THEN
137 IF(ialel==0)THEN
138 iprt=ipartsp(n)
139 mt =ipart(1,iprt)
140 VALUE=pm(89,mt)*gbuf%VOL(i)
141 ELSE
142 off = min(gbuf%OFF(i),one)
143 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
144 ENDIF
145 mas(el2fa(nn3+n_fa)) = VALUE
146 ENDIF
147 140 CONTINUE
148C
149 ELSE
150 ENDIF
151C-----------------------------------------------
152C END OF LOOP ON OFFSETS
153C-----------------------------------------------
154 END DO
155 490 CONTINUE
156C-----------------------------------------------
157C
158 RETURN
159 END
my_real
#define my_real
Definition cppsort.cpp:32
dmasanis
subroutine dmasanis(elbuf_tab, iparg, ixs, mas, pm, el2fa, nbf, ipart, ipartsp, isph3d)
Definition dmasanis.F:34
min
#define min(a, b)
Definition macros.h:20
initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure)
Definition initbuf.F:38