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
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "vect01_c.inc"
46#include "mvsiz_p.inc"
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "scr17_c.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54C REAL
55 my_real
56 . mas(*) ,pm(npropm,*)
57 INTEGER IPARG(NPARG,*),IXS(NIXS,*),EL2FA(*),NBF,IPART(LIPART1,*),
58 . IPARTSP(*),ISPH3D
59 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 my_real
64 . evar(mvsiz),
65 . off,VALUE
66 INTEGER I, NG, NEL, ISS, ISC,N, J, MLW,
67 . NN, K1, K2,JTURB,MT, IALEL,IPID,
68 . n1,n2,n3,n4,nn1,nn2,nn3,
69 . offset,nft_fa,n_fa,
70 . inod, isolnod, iprt,
71 . jhbe, jivf, jclose, jplasol, irep, igtyp,
72 . icsen, isorthg, ifailure, iint
73 TYPE(g_bufel_) ,POINTER :: GBUF
74 REAL R4
75C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
76 nn1 = 1
77 nn2 = 1
78 nn3 = nn2 + numels
79C-----------------------------------------------
80C face ext
81C-----------------------------------------------
82 DO 490 ng=1,ngroup
83 CALL initbuf (iparg ,ng ,
84 2 mlw ,nel ,nft ,iad ,ity ,
85 3 npt ,jale ,ismstr ,jeul ,jtur ,
86 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
87 5 jpor ,jcvt ,jclose ,jplasol ,
88 6 irep ,iint ,igtyp ,israt ,isrot ,
89 7 icsen ,isorth ,isorthg ,ifailure)
90 isolnod = iparg(28,ng)
91 DO offset = 0,nel-1,nvsiz
92 nft =iparg(3,ng) + offset
93 iad =iparg(4,ng)
94 lft=1
95 llt=min(nvsiz,nel-offset)
96 nft_fa = nft
97C-----------------------------------------------
98C SOLIDE
99C-----------------------------------------------
100 IF (ity==1 .and. mlw > 0) THEN
101 ialel=iparg(7,ng)+iparg(11,ng)
102 gbuf => elbuf_tab(ng)%GBUF
103 DO 130 i=lft,llt
104 n = i + nft
105 n_fa = i + nft_fa
106 IF(el2fa(nn2+n_fa)/=0)THEN
107 IF(ialel==0)THEN
108 mt=ixs(1,n)
109 VALUE=pm(89,mt)*gbuf%VOL(i)
110 ELSE
111 off = min(gbuf%OFF(i),one)
112 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
113 ENDIF
114 IF(isolnod==16)THEN
115 VALUE = fourth*VALUE
116 mas(el2fa(nn2+n_fa)) = VALUE
117 mas(el2fa(nn2+n_fa)+1) = VALUE
118 mas(el2fa(nn2+n_fa)+2) = VALUE
119 mas(el2fa(nn2+n_fa)+3) = VALUE
120 ELSE
121 mas(el2fa(nn2+n_fa)) = VALUE
122 ENDIF
123 ENDIF
124 130 CONTINUE
125C
126 ELSEIF(isph3d==1.AND.ity==51.and.mlw > 0)THEN
127C-----------------------------------------------
128C TETRAS SPH.
129C-----------------------------------------------
130 gbuf => elbuf_tab(ng)%GBUF
131 ialel=iparg(7,ng)+iparg(11,ng)
132 DO 140 i=lft,llt
133 n = i + nft
134 n_fa = i + nft_fa
135 IF(el2fa(nn3+n_fa)/=0)THEN
136 IF(ialel==0)THEN
137 iprt=ipartsp(n)
138 mt =ipart(1,iprt)
139 VALUE=pm(89,mt)*gbuf%VOL(i)
140 ELSE
141 off = min(gbuf%OFF(i),one)
142 VALUE=gbuf%RHO(i)*gbuf%VOL(i)*off
143 ENDIF
144 mas(el2fa(nn3+n_fa)) = VALUE
145 ENDIF
146 140 CONTINUE
147C
148 ELSE
149 ENDIF
150C-----------------------------------------------
151C FIN DE BOUCLE SUR LES OFFSET
152C-----------------------------------------------
153 END DO
154 490 CONTINUE
155C-----------------------------------------------
156C
157 RETURN
158 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