OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10volnod3.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!|| s10volnod3 ../engine/source/elements/solid/solide4_sfem/s10volnod3.F
25!||--- called by ------------------------------------------------------
26!|| s4lagsfem ../engine/source/elements/solid/solide4_sfem/s4lagsfem.F
27!||--- calls -----------------------------------------------------
28!|| foat_to_6_float ../engine/source/system/parit.F
29!|| s10volj ../engine/source/elements/solid/solide4_sfem/s10volj.F
30!||====================================================================
31 SUBROUTINE s10volnod3(
32 1 VOLNOD6, X, NC, OFFG,
33 2 VOLG, XDP, NEL, NPT,
34 3 ISMSTR)
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43#include "param_c.inc"
44#include "com04_c.inc"
45#include "scr05_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER, INTENT(IN) :: NPT
50 INTEGER, INTENT(IN) :: ISMSTR
51 INTEGER NEL,NC(MVSIZ,10)
52 double precision
53 . volnod6(6,2*numnod)
54C REAL
56 . x(3,numnod),offg(nel)
57 DOUBLE PRECISION , DIMENSION(3,SXDP/3), INTENT(IN) :: XDP
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, K,N1,N2,NN,N
65 INTEGER IP,K1,K2,K3,K4,K5,K6,K7,K8,K9,K10
66 INTEGER IPERM1(10),IPERM2(10),IPERM(10,4)
67 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
68 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
69 DATA iperm/
70 . 2, 4, 3, 1, 9,10, 6, 5, 8, 7,
71 . 4, 1, 3, 2, 8, 7,10, 9, 5, 6,
72 . 1, 4, 2, 3, 8, 9, 5, 7,10, 6,
73 . 1, 2, 3, 4, 5, 6, 7, 8, 9,10/
74
75 double precision
76 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10),
77 . xa(mvsiz,10),ya(mvsiz,10),za(mvsiz,10),
78 . xb(mvsiz,10),yb(mvsiz,10),zb(mvsiz,10),
79 . a4,b4,a4m1,b4m1,aa,det6(6,mvsiz),voldp(mvsiz)
81 . volg(mvsiz),alph,beta,w
82C----------------------------
83C NODAL COORDINATES
84C----------------------------
85 IF (ismstr==1.OR.ismstr==11) RETURN
86C----------------------------
87 IF(iresp == 1) THEN
88 DO n=1,10
89 DO i=1,nel
90 nn = max(1,nc(i,n))
91 xx(i,n)=xdp(1,nn)
92 yy(i,n)=xdp(2,nn)
93 zz(i,n)=xdp(3,nn)
94 ENDDO
95 ENDDO
96 ELSE
97 DO n=1,10
98 DO i=1,nel
99 nn = max(1,nc(i,n))
100 xx(i,n)=x(1,nn)
101 yy(i,n)=x(2,nn)
102 zz(i,n)=x(3,nn)
103 ENDDO
104 ENDDO
105 END IF !(IRESP == 1) THEN
106C
107 DO n=5,10
108 n1=iperm1(n)
109 n2=iperm2(n)
110 DO i=1,nel
111 IF(nc(i,n)==0)THEN
112 xx(i,n) = half*(xx(i,n1)+xx(i,n2))
113 yy(i,n) = half*(yy(i,n1)+yy(i,n2))
114 zz(i,n) = half*(zz(i,n1)+zz(i,n2))
115 ENDIF
116 ENDDO
117 ENDDO
118C NPT =4
119 alph = zep5854102
120 beta = zep1381966
121 w = fourth
122 a4 = four * alph
123 b4 = four * beta
124 a4m1 = a4- one
125 b4m1 = b4- one
126C
127 DO n=1,4
128 DO i=1,nel
129 xa(i,n) = a4m1*xx(i,n)
130 ya(i,n) = a4m1*yy(i,n)
131 za(i,n) = a4m1*zz(i,n)
132C
133 xb(i,n) = b4m1*xx(i,n)
134 yb(i,n) = b4m1*yy(i,n)
135 zb(i,n) = b4m1*zz(i,n)
136 ENDDO
137 ENDDO
138C
139 DO n=5,10
140 DO i=1,nel
141 xa(i,n) = a4*xx(i,n)
142 ya(i,n) = a4*yy(i,n)
143 za(i,n) = a4*zz(i,n)
144C
145 xb(i,n) = b4*xx(i,n)
146 yb(i,n) = b4*yy(i,n)
147 zb(i,n) = b4*zz(i,n)
148 ENDDO
149 ENDDO
150C
151 volg(1:nel) =zero
152 DO ip=1,4
153 k1 = iperm(1,ip)
154 k2 = iperm(2,ip)
155 k3 = iperm(3,ip)
156 k4 = iperm(4,ip)
157 k5 = iperm(5,ip)
158 k6 = iperm(6,ip)
159 k7 = iperm(7,ip)
160 k8 = iperm(8,ip)
161 k9 = iperm(9,ip)
162 k10= iperm(10,ip)
163 CALL s10volj(w,
164 . xb(1,k1),xb(1,k2),xb(1,k3),xa(1,k4),xb(1,k5),
165 . xb(1,k6),xb(1,k7),xb(1,k8),xb(1,k9),xb(1,k10),
166 . xa(1,k8),xa(1,k9),xa(1,k10),
167 . yb(1,k1),yb(1,k2),yb(1,k3),ya(1,k4),yb(1,k5),
168 . yb(1,k6),yb(1,k7),yb(1,k8),yb(1,k9),yb(1,k10),
169 . ya(1,k8),ya(1,k9),ya(1,k10),
170 . zb(1,k1),zb(1,k2),zb(1,k3),za(1,k4),zb(1,k5),
171 . zb(1,k6),zb(1,k7),zb(1,k8),zb(1,k9),zb(1,k10),
172 . za(1,k8),za(1,k9),za(1,k10),
173 . voldp,nel)
174c
175 volg(1:nel) =volg(1:nel) + voldp(1:nel)
176 ENDDO
177 DO i=1,nel
178 IF (offg(i) == zero .OR. abs(offg(i))>one) THEN
179 volg(i)= zero
180 ENDIF
181 ENDDO
182
183 !Parith-On treatment
184 CALL foat_to_6_float(1 ,nel ,volg ,det6 )
185
186 DO i=1,nel
187C----------------------------------
188C VOLUME <0 SERA TESTE DANS S4DERI3
189C----------------------------------
190 !Parith-On treatment
191 DO k=1,6
192 volnod6(k,nc(i,1)) = volnod6(k,nc(i,1)) + det6(k,i)
193 volnod6(k,nc(i,2)) = volnod6(k,nc(i,2)) + det6(k,i)
194 volnod6(k,nc(i,3)) = volnod6(k,nc(i,3)) + det6(k,i)
195 volnod6(k,nc(i,4)) = volnod6(k,nc(i,4)) + det6(k,i)
196 ENDDO
197 ENDDO
198C
199 RETURN
200 END
#define my_real
Definition cppsort.cpp:32
#define max(a, b)
Definition macros.h:21
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:225
subroutine s10volj(w, x1b, x2b, x3b, x4a, x5b, x6b, x7b, x8b, x9b, x10b, x8a, x9a, x10a, y1b, y2b, y3b, y4a, y5b, y6b, y7b, y8b, y9b, y10b, y8a, y9a, y10a, z1b, z2b, z3b, z4a, z5b, z6b, z7b, z8b, z9b, z10b, z8a, z9a, z10a, voldp, nel)
Definition s10volj.F:33
subroutine s10volnod3(volnod6, x, nc, offg, volg, xdp, nel, npt, ismstr)
Definition s10volnod3.F:35