OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dmasanis.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dmasanis (elbuf_tab, iparg, ixs, mas, pm, el2fa, nbf, ipart, ipartsp, isph3d)

Function/Subroutine Documentation

◆ dmasanis()

subroutine dmasanis ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
mas,
pm,
integer, dimension(*) el2fa,
integer nbf,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartsp,
integer isph3d )

Definition at line 31 of file dmasanis.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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