OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inte_qd.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!|| inthqd ../starter/source/fluid/inte_qd.F
25!||--- called by ------------------------------------------------------
26!|| mass_fluid_qd ../starter/source/fluid/mass-fluid_qd.F
27!||====================================================================
28 SUBROUTINE inthqd(X1 , Y1, Z1, X2, Y2, Z2,
29 . X3, Y3, Z3, X4, Y4, Z4,
30 . XP, YP, ZP, XS, YS, ZS,
31 . NRX, NRY, NRZ, D2, JAC,RVAL)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C D u m m y A r g u m e n t s
38C-----------------------------------------------
39 my_real
40 . x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4,
41 . xp, yp, zp, d2, jac, nrx, nry, nrz,
42 . xs, ys, zs, rval
43C-----------------------------------------------
44C L o c a l V a r i a b l e s
45C-----------------------------------------------
46 INTEGER NPG, IAD, IAD2, IP
47 my_real
48 . PG(28), WPG(14), R2, W, XG, YG, ZG,
49 . val1, val2, val3, val4, valphi,
50 . ksip, etap
51C
52 DATA pg / .0000000000000, .0000000000000,
53 . -.5773502691896,-.5773502691896,
54 . .5773502691896,-.5773502691896,
55 . -.5773502691896, .5773502691896,
56 . .5773502691896, .5773502691896,
57 . -.7745966692415,-.7745966692415,
58 . .0000000000000,-.7745966692415,
59 . .7745966692415,-.7745966692415,
60 . -.7745966692415, .0000000000000,
61 . .0000000000000, .0000000000000,
62 . .7745966692415, .0000000000000,
63 . -.7745966692415, .7745966692415,
64 . .0000000000000, .7745966692415,
65 . .7745966692415, .7745966692415/
66 DATA wpg / 1.00000000000,
67 . .2500000000000, .2500000000000,
68 . .2500000000000, .2500000000000,
69 . .0771604938272, .1234567901234,
70 . .0771604938272, .1234567901234,
71 . .1975308641975, .1234567901234,
72 . .0771604938272, .1234567901234,
73 . .0771604938272/
74C-------------------------------------------------------------
75C DISTANCE A LA SOURCE
76 r2=(xp-xs)**2+(yp-ys)**2+(zp-zs)**2
77C NOMBRE DE POINTS DE GAUSS
78 IF (r2>hundred*d2) THEN
79 npg=1
80 iad=1
81 ELSEIF (r2>twenty5*d2) THEN
82 npg=4
83 iad=2
84 ELSE
85 npg=9
86 iad=6
87 ENDIF
88C INTEGRATION
89 rval=zero
90 iad2=2*(iad-1)+1
91 DO ip=1,npg
92 w=wpg(iad)
93 ksip=pg(iad2)
94 etap=pg(iad2+1)
95 iad=iad+1
96 iad2=iad2+2
97 val1=fourth*(one-ksip)*(one-etap)
98 val2=fourth*(one+ksip)*(one-etap)
99 val3=fourth*(one+ksip)*(one+etap)
100 val4=fourth*(one-ksip)*(one+etap)
101 xg=val1*x1+val2*x2+val3*x3+val4*x4
102 yg=val1*y1+val2*y2+val3*y3+val4*y4
103 zg=val1*z1+val2*z2+val3*z3+val4*z4
104 r2=(xg-xp)**2+(yg-yp)**2+(zg-zp)**2
105 IF(r2>em20)THEN
106 valphi=-(nrx*(xg-xp)+nry*(yg-yp)+nrz*(zg-zp))/(r2**three_half)
107 rval =rval+w*valphi*jac
108 ENDIF
109 ENDDO
110C
111 RETURN
112 END
113C
114C
115!||====================================================================
116!|| intgqd ../starter/source/fluid/inte_qd.F
117!||--- called by ------------------------------------------------------
118!|| mass_fluid_qd ../starter/source/fluid/mass-fluid_qd.F
119!||====================================================================
120 SUBROUTINE intgqd(X1 , Y1, Z1, X2, Y2, Z2,
121 . X3, Y3, Z3, X4, Y4, Z4,
122 . XP, YP, ZP, XS, YS, ZS,
123 . D2, JAC,RVAL)
124C-----------------------------------------------
125C I m p l i c i t T y p e s
126C-----------------------------------------------
127#include "implicit_f.inc"
128C-----------------------------------------------
129C D u m m y A r g u m e n t s
130C-----------------------------------------------
131 my_real
132 . x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4,
133 . xp, yp, zp, d2, jac,
134 . xs, ys, zs, rval
135C-----------------------------------------------
136C L o c a l V a r i a b l e s
137C-----------------------------------------------
138 INTEGER NPG, IAD, IAD2, IP
139 my_real
140 . PG(28), WPG(14), R2, W, XG, YG, ZG,
141 . VAL1, VAL2, VAL3, VAL4, VALPHI,
142 . KSIP, ETAP
143C
144 DATA pg / .0000000000000, .0000000000000,
145 . -.5773502691896,-.5773502691896,
146 . .5773502691896,-.5773502691896,
147 . -.5773502691896, .5773502691896,
148 . .5773502691896, .5773502691896,
149 . -.7745966692415,-.7745966692415,
150 . .0000000000000,-.7745966692415,
151 . .7745966692415,-.7745966692415,
152 . -.7745966692415, .0000000000000,
153 . .0000000000000, .0000000000000,
154 . .7745966692415, .0000000000000,
155 . -.7745966692415, .7745966692415,
156 . .0000000000000, .7745966692415,
157 . .7745966692415, .7745966692415/
158 DATA wpg / 1.00000000000,
159 . .2500000000000, .2500000000000,
160 . .2500000000000, .2500000000000,
161 . .0771604938272, .1234567901234,
162 . .0771604938272, .1234567901234,
163 . .1975308641975, .1234567901234,
164 . .0771604938272, .1234567901234,
165 . .0771604938272/
166C-------------------------------------------------------------
167C DISTANCE A LA SOURCE
168 r2=(xp-xs)**2+(yp-ys)**2+(zp-zs)**2
169C NOMBRE DE POINTS DE GAUSS
170 IF (r2>hundred*d2) THEN
171 npg=1
172 iad=1
173 ELSEIF (r2>twenty5*d2) THEN
174 npg=4
175 iad=2
176 ELSE
177 npg=9
178 iad=6
179 ENDIF
180C INTEGRATION
181 rval=zero
182 iad2=2*(iad-1)+1
183 DO ip=1,npg
184 w=wpg(iad)
185 ksip=pg(iad2)
186 etap=pg(iad2+1)
187 iad=iad+1
188 iad2=iad2+2
189 val1=fourth*(one-ksip)*(one-etap)
190 val2=fourth*(one+ksip)*(one-etap)
191 val3=fourth*(one+ksip)*(one+etap)
192 val4=fourth*(one-ksip)*(one+etap)
193 xg=val1*x1+val2*x2+val3*x3+val4*x4
194 yg=val1*y1+val2*y2+val3*y3+val4*y4
195 zg=val1*z1+val2*z2+val3*z3+val4*z4
196 r2=(xg-xp)**2+(yg-yp)**2+(zg-zp)**2
197 IF(r2>em20)THEN
198 valphi=one/sqrt(r2)
199 rval =rval+w*valphi*jac
200 ENDIF
201 ENDDO
202C
203 RETURN
204 END
205
my_real
#define my_real
Definition cppsort.cpp:32
intgqd
subroutine intgqd(x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, xp, yp, zp, xs, ys, zs, d2, jac, rval)
Definition inte_qd.F:124
inthqd
subroutine inthqd(x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, xp, yp, zp, xs, ys, zs, nrx, nry, nrz, d2, jac, rval)
Definition inte_qd.F:32