OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
amulf2.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!|| amulf2 ../engine/source/ale/bimat/amulf2.F
25!||--- called by ------------------------------------------------------
26!|| aflux2 ../engine/source/ale/ale2d/aflux2.f
27!|| eflux2 ../engine/source/ale/euler2d/eflux2.F
28!||--- uses -----------------------------------------------------
29!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
30!||====================================================================
31 SUBROUTINE amulf2(FILL,DFILL,FLUX,FLU1,VOL,ALE_CONNECT,ALPV,
32 . FLUX1, FLUX2, FLUX3, FLUX4, UPW,
33 . NC1, NC2, NC3, NC4)
34 USE ale_connectivity_mod
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"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "vect01_c.inc"
47#include "com04_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 my_real
52 . fill(numnod,*), dfill(numnod,*), flux(4,*), flu1(*), vol(*),
53 . alpv(2,*), flux1(*), flux2(*), flux3(*), flux4(*), upw(*)
54 INTEGER NC1(*), NC2(*), NC3(*), NC4(*)
55 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER JM, I, II, JJ, IAD2
60 my_real
61 . flub1(mvsiz), flub2(mvsiz),
62 . flub3(mvsiz), flub4(mvsiz), alpn1, alpn2, alpn3, alpn4, alpd1,
63 . alpd2, alpd3, alpd4, alp1, calp1, alpd, alph, alp2, calp2
64C-----------------------------------------------
65 DO jm=1,jmult
66C
67 DO i=lft,llt
68 ii=i+nft
69 iad2 = ale_connect%ee_connect%iad_connect(ii)
70 alpn1= max(zero,fill(nc1(i),jm))
71 . + max(zero,fill(nc1(i),jm)-dfill(nc1(i),jm))
72 alpn2= max(zero,fill(nc2(i),jm))
73 . + max(zero,fill(nc2(i),jm)-dfill(nc2(i),jm))
74 alpn3= max(zero,fill(nc3(i),jm))
75 . + max(zero,fill(nc3(i),jm)-dfill(nc3(i),jm))
76 alpn4= max(zero,fill(nc4(i),jm))
77 . + max(zero,fill(nc4(i),jm)-dfill(nc4(i),jm))
78 alpd1=abs(fill(nc1(i),jm))
79 . +abs(fill(nc1(i),jm)-dfill(nc1(i),jm))
80 alpd2=abs(fill(nc2(i),jm))
81 . +abs(fill(nc2(i),jm)-dfill(nc2(i),jm))
82 alpd3=abs(fill(nc3(i),jm))
83 . +abs(fill(nc3(i),jm)-dfill(nc3(i),jm))
84 alpd4=abs(fill(nc4(i),jm))
85 . +abs(fill(nc4(i),jm)-dfill(nc4(i),jm))
86
87 alp1 =alpv(jm,ii) *vol(ii)
88 calp1=(one -alpv(jm,ii))*vol(ii)
89
90 alpd=alpd1+alpd2
91 IF(alpd==zero)THEN
92 alph=one
93 ELSE
94 alph=(alpn1+alpn2)/alpd
95 ENDIF
96 flub1(i)=flux1(i)*alph
97 IF(flux1(i)>=zero)THEN
98 flub1(i)= max(flub1(i),flux1(i)-calp1)
99 flub1(i)= min(flub1(i),alp1)
100 ELSE
101 jj=ale_connect%ee_connect%connected(iad2 + 1 - 1)
102 IF(jj==0)jj=ii
103 alp2 =alpv(jm,jj) *vol(jj)
104 calp2=(one - alpv(jm,jj))*vol(jj)
105 flub1(i)=-max(-flub1(i),-flux1(i)-calp2)
106 flub1(i)=-min(-flub1(i),alp2)
107 ENDIF
108
109 alpd=alpd2+alpd3
110 IF(alpd==zero)THEN
111 alph=one
112 ELSE
113 alph=(alpn2+alpn3)/alpd
114 ENDIF
115 flub2(i)=flux2(i)*alph
116 IF(flux2(i)>=zero)THEN
117 flub2(i)= max(flub2(i),flux2(i)-calp1)
118 flub2(i)= min(flub2(i),alp1)
119 ELSE
120 jj=ale_connect%ee_connect%connected(iad2 + 2 - 1)
121 IF(jj==0)jj=ii
122 alp2 =alpv(jm,jj) *vol(jj)
123 calp2=(one-alpv(jm,jj))*vol(jj)
124 flub2(i)=-max(-flub2(i),-flux2(i)-calp2)
125 flub2(i)=-min(-flub2(i),alp2)
126 ENDIF
127
128 alpd=alpd3+alpd4
129 IF(alpd==zero)THEN
130 alph=one
131 ELSE
132 alph=(alpn3+alpn4)/alpd
133 ENDIF
134 flub3(i)=flux3(i)*alph
135 IF(flux3(i)>=zero)THEN
136 flub3(i)= max(flub3(i),flux3(i)-calp1)
137 flub3(i)= min(flub3(i),alp1)
138 ELSE
139 jj=ale_connect%ee_connect%connected(iad2 + 3 - 1)
140 IF(jj==0)jj=ii
141 alp2 =alpv(jm,jj) *vol(jj)
142 calp2=(one-alpv(jm,jj))*vol(jj)
143 flub3(i)=-max(-flub3(i),-flux3(i)-calp2)
144 flub3(i)=-min(-flub3(i),alp2)
145 ENDIF
146
147 alpd=alpd4+alpd1
148 IF(alpd==zero)THEN
149 alph=one
150 ELSE
151 alph=(alpn4+alpn1)/alpd
152 ENDIF
153 flub4(i)=flux4(i)*alph
154 IF(flux4(i)>=zero)THEN
155 flub4(i)= max(flub4(i),flux4(i)-calp1)
156 flub4(i)= min(flub4(i),alp1)
157 ELSE
158 jj=ale_connect%ee_connect%connected(iad2 + 4 - 1)
159 IF(jj==0)jj=ii
160 alp2 =alpv(jm,jj) *vol(jj)
161 calp2=(one-alpv(jm,jj))*vol(jj)
162 flub4(i)=-max(-flub4(i),-flux4(i)-calp2)
163 flub4(i)=-min(-flub4(i),alp2)
164 ENDIF
165
166 ENDDO !next I
167
168 DO i=lft,llt
169 ii=i+(jm-1)*numelq
170 flux(1,ii)=flub1(i)-upw(i)*abs(flub1(i))
171 flux(2,ii)=flub2(i)-upw(i)*abs(flub2(i))
172 flux(3,ii)=flub3(i)-upw(i)*abs(flub3(i))
173 flux(4,ii)=flub4(i)-upw(i)*abs(flub4(i))
174
175 flu1(ii) =flub1(i)+upw(i)*abs(flub1(i))
176 . +flub2(i)+upw(i)*abs(flub2(i))
177 . +flub3(i)+upw(i)*abs(flub3(i))
178 . +flub4(i)+upw(i)*abs(flub4(i))
179 ENDDO
180
181 ENDDO !next JM
182
183 RETURN
184 END
aflux2
subroutine aflux2(pm, ixq, v, w, x, flux, flu1, fill, dfill, vol, ale_connect, alph)
Definition aflux2.F:35
amulf2
subroutine amulf2(fill, dfill, flux, flu1, vol, ale_connect, alpv, flux1, flux2, flux3, flux4, upw, nc1, nc2, nc3, nc4)
Definition amulf2.F:34
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223