OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qhvis2.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!|| qhvis2 ../engine/source/elements/solid_2d/quad/qhvis2.F
25!||--- called by ------------------------------------------------------
26!|| bforc2 ../engine/source/ale/bimat/bforc2.F
27!|| qforc2 ../engine/source/elements/solid_2d/quad/qforc2.F
28!||--- uses -----------------------------------------------------
29!|| ale_mod ../common_source/modules/ale/ale_mod.F
30!||====================================================================
31 SUBROUTINE qhvis2(PM,OFF,RHO,
32 . Y1,Y2,Y3,Y4,Z1,Z2,Z3,Z4,
33 . VY1,VY2,VY3,VY4,VZ1,VZ2,VZ3,VZ4,
34 . PY1,PY2,PZ1,PZ2,
35 . T11,T12,T13,T14,T21,T22,T23,T24,
36 . AREA,CXX,MAT,VD2,VIS,EANI,PID,GEO,
37 . PARTSAV,IPARTQ,EHOU, IPARG)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE ale_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "param_c.inc"
55#include "vect01_c.inc"
56#include "cong1_c.inc"
57#include "com04_c.inc"
58#include "com06_c.inc"
59#include "com08_c.inc"
60#include "scr14_c.inc"
61#include "scr16_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 my_real pm(npropm,nummat),geo(npropg,numgeo), off(*), rho(*),eani(*),
66 . y1(*),y2(*),y3(*),y4(*),z1(*),z2(*),z3(*),z4(*),
67 . vy1(*), vy2(*), vy3(*), vy4(*), vz1(*), vz2(*), vz3(*),
68 . py1(*), py2(*), pz1(*), pz2(*),ehou(*),
69 . t11(*), t12(*), t13(*), t14(*), t21(*), t22(*), t23(*), t24(*),
70 . vz4(*), area(*), cxx(*),vd2(*),vis(*), partsav(npsav,*)
71 INTEGER MAT(*),PID(*),IPARTQ(NUMELQ), IPARG(63:63)
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,MX, ISFLUID
76 my_real CAQ(MVSIZ),
77 . fcl(mvsiz) , fcq(mvsiz),
78 . g11(mvsiz) , g21(mvsiz) , g31(mvsiz) , g41(mvsiz),
79 . hgy(mvsiz), hgz(mvsiz),
80 . hy,hz,fac,px1h1,px2h1,ehourt, are
81C-----------------------------------------------
82C P r e c o n d i t i o n s
83C-----------------------------------------------
84 IF(mtn == 11 .OR. ((mtn == 17 .OR. mtn == 47) .AND. ale%UPWIND%UPWM == 0))THEN
85 DO i=lft,llt
86 t11(i) = zero
87 t12(i) = zero
88 t13(i) = zero
89 t14(i) = zero
90 t21(i) = zero
91 t22(i) = zero
92 t23(i) = zero
93 t24(i) = zero
94 ENDDO
95 RETURN
96 ENDIF
97C-----------------------------------------------
98C S o u r c e L i n e s
99C-----------------------------------------------
100 IF(invstr >= 35)THEN
101 DO i=lft,llt
102 caq(i)=geo(13,pid(i))
103 ENDDO
104 ELSE
105 DO i=lft,llt
106 caq(i)=pm(4,mat(i))
107 ENDDO
108 ENDIF
109
110 DO i=lft,llt
111 are=max(area(i),em20)
112 fcq(i)=rho(i)*sqrt(are)
113 fcl(i)=caq(i)*fcq(i)
114 ENDDO
115
116 isfluid=iparg(63)
117
118 IF(isfluid == 1 .AND. ale%UPWIND%UPWM == 0)THEN
119 DO i=lft,llt
120 fcl(i)=fcl(i)*cxx(i)
121 fcq(i)=zero
122 ENDDO
123 ELSEIF(isfluid == 1 .AND. ale%UPWIND%UPWM == 1)THEN
124 DO i=lft,llt
125 fcl(i)=min(fcl(i)*cxx(i),max(20.*caq(i)*vis(i),fcl(i)*sqrt(vd2(i))))
126 fcq(i)=zero
127 ENDDO
128 ELSEIF(isfluid == 1 .AND. ale%UPWIND%UPWM > 0)THEN
129 DO i=lft,llt
130 IF(vis(i) > zero)THEN
131 fcq(i)=zero
132 fcl(i)=twenty*caq(i)*vis(i)
133 ELSE
134 fcq(i)=fcl(i)*caq(i)*hundred
135 fcl(i)=fcl(i)*cxx(i)
136 ENDIF
137 ENDDO
138 ELSE
139 DO i=lft,llt
140 fcq(i)=fcl(i)*caq(i)*hundred
141 fcl(i)=fcl(i)*cxx(i)
142 ENDDO
143 ENDIF
144 IF(impl /= zero)THEN
145 DO i=lft,llt
146 fcq(i)=zero
147 ENDDO
148 ENDIF
149
150 DO i=lft,llt
151 IF(off(i) < one)THEN
152 fcl(i)=zero
153 fcq(i)=zero
154 ENDIF
155 ENDDO
156
157 IF(jhbe == 0)THEN
158 !
159 ! HOURGLASS HALLQUIST
160 !
161 DO i=lft,llt
162 hgy(i)=half*(vy1(i)-vy2(i)+vy3(i)-vy4(i))
163 hgz(i)=half*(vz1(i)-vz2(i)+vz3(i)-vz4(i))
164 ENDDO
165 DO i=lft,llt
166 t11(i)=hgy(i)*(fcl(i)+abs(hgy(i))*fcq(i))
167 t12(i)=-t11(i)
168 t13(i)= t11(i)
169 t14(i)=-t11(i)
170 t21(i)=hgz(i)*(fcl(i)+abs(hgz(i))*fcq(i))
171 t22(i)=-t21(i)
172 t23(i)= t21(i)
173 t24(i)=-t21(i)
174 ehou(i)= two*dt1*(t11(i)*hgy(i) + t21(i)*hgz(i))
175 ENDDO
176 ELSE
177 !
178 ! HOURGLASS BELYTSCHKO
179 !
180 DO i=lft,llt
181 hy=y1(i)-y2(i)+y3(i)-y4(i)
182 hz=z1(i)-z2(i)+z3(i)-z4(i)
183 fac=one/max(em20,area(i))
184 px1h1=fac*(py1(i)*hy+pz1(i)*hz)
185 px2h1=fac*(py2(i)*hy+pz2(i)*hz)
186 g11(i)= one -px1h1
187 g21(i)=-one -px2h1
188 g31(i)= one +px1h1
189 g41(i)=-one +px2h1
190 ENDDO
191 DO i=lft,llt
192 hgy(i)=half*(g11(i)*vy1(i)+g21(i)*vy2(i)+g31(i)*vy3(i)+g41(i)*vy4(i))
193 hgz(i)=half*(g11(i)*vz1(i)+g21(i)*vz2(i)+g31(i)*vz3(i)+g41(i)*vz4(i))
194 ENDDO
195 DO i=lft,llt
196 hy=hgy(i)*(fcl(i)+abs(hgy(i))*fcq(i))
197 hz=hgz(i)*(fcl(i)+abs(hgz(i))*fcq(i))
198 t11(i) =g11(i)*hy
199 t12(i) =g21(i)*hy
200 t13(i) =g31(i)*hy
201 t14(i) =g41(i)*hy
202 t21(i) =g11(i)*hz
203 t22(i) =g21(i)*hz
204 t23(i) =g31(i)*hz
205 t24(i) =g41(i)*hz
206 ehou(i)= two*dt1*(hy*hgy(i) + hz*hgz(i))
207 ENDDO
208 ENDIF
209
210 IF(jlag == 1)THEN
211 ehourt = zero
212 DO i=lft,llt
213 ehourt= ehourt+ehou(i)
214 ENDDO
215 DO i=lft,llt
216 mx = ipartq(i)
217 partsav(8,mx)=partsav(8,mx) + ehou(i)
218 ENDDO
219!$OMP ATOMIC
220 ehour = ehour + ehourt
221 ENDIF !JLAG
222
223 ! OUTPUT (ANIM & H3D)
224 DO i=lft,llt
225 eani(nft+i) = eani(nft+i)+ehou(i)/max(em30,rho(i)*area(i))
226 ENDDO
227
228C-----------------------------------------------
229 RETURN
230 END
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
qhvis2
subroutine qhvis2(pm, off, rho, y1, y2, y3, y4, z1, z2, z3, z4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, py1, py2, pz1, pz2, t11, t12, t13, t14, t21, t22, t23, t24, area, cxx, mat, vd2, vis, eani, pid, geo, partsav, ipartq, ehou, iparg)
Definition qhvis2.F:38