OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admvit.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!|| admvit ../engine/source/model/remesh/admvit.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!||--- uses -----------------------------------------------------
30!|| remesh_mod ../engine/share/modules/remesh_mod.F
31!||====================================================================
32 SUBROUTINE admvit(IXC ,IPARTC ,IXTG ,IPARTTG ,IPART ,
33 . ITASK ,A ,V ,AR ,VR ,
34 . SH4TREE,SH3TREE,TEMP,ITHERM_FE)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE remesh_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43#include "comlock.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "com08_c.inc"
49#include "param_c.inc"
50#include "remesh_c.inc"
51#include "scr17_c.inc"
52#include "task_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IXC(NIXC,*), IPARTC(*), IXTG(NIXTG,*), IPARTTG(*),
57 . IPART(LIPART1,*), ITASK, SH4TREE(KSH4TREE,*),
58 . sh3tree(ksh3tree,*)
59 my_real
60 . a(3,*),v(3,*),ar(3,*),vr(3,*), temp(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER SH4FT, SH4LT, SH3FT, SH3LT
65 INTEGER N, NN, LEVEL, IP, NLEV, LL, IERR
66 INTEGER SON,M(4),MC,N1,N2,N3,N4,J,NA,NB
67 integer ,INTENT(IN) :: ITHERM_FE
68 my_real :: vv, usdt
69C-----------------------------------------------
70 usdt=one/dt12
71C
72C allocation tag
73 IF(itask==0)THEN
74 tagnod=0
75 END IF
76C
77 CALL my_barrier
78C
79C-------
80 DO level=0,levelmax-1
81
82 ll=psh4kin(level+1)-psh4kin(level)
83 sh4ft = psh4kin(level)+ 1+itask*ll/ nthread
84 sh4lt = psh4kin(level)+ (itask+1)*ll/nthread
85
86 DO nn=sh4ft,sh4lt
87 n =lsh4kin(nn)
88C
89 n1=ixc(2,n)
90 n2=ixc(3,n)
91 n3=ixc(4,n)
92 n4=ixc(5,n)
93C
94 son=sh4tree(2,n)
95C
96 mc=ixc(3,son+3)
97
98 IF(tagnod(mc)==0)THEN
99 tagnod(mc)=1
100 DO j=1,3
101 vv= fourth*(v(j,n1)+v(j,n2)+v(j,n3)+v(j,n4)
102 . +dt12*(a(j,n1)+a(j,n2)+a(j,n3)+a(j,n4)))
103 a(j,mc)=usdt*(vv-v(j,mc))
104 END DO
105 DO j=1,3
106 vv= fourth*(vr(j,n1)+vr(j,n2)+vr(j,n3)+vr(j,n4)
107 . +dt12*(ar(j,n1)+ar(j,n2)+ar(j,n3)+ar(j,n4)))
108 ar(j,mc)=usdt*(vv-vr(j,mc))
109 END DO
110 IF(itherm_fe > 0)
111 . temp(mc)=fourth*(temp(n1)+temp(n2)+temp(n3)+temp(n4))
112 END IF
113C
114 m(1)=ixc(3,son )
115 m(2)=ixc(4,son+1)
116 m(3)=ixc(5,son+2)
117 m(4)=ixc(2,son+3)
118
119 IF(tagnod(m(1))==0)THEN
120 tagnod(m(1))=1
121 na=min(n1,n2)
122 nb=max(n1,n2)
123 DO j=1,3
124 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
125 a(j,m(1))=usdt*(vv-v(j,m(1)))
126 END DO
127 DO j=1,3
128 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
129 ar(j,m(1))=usdt*(vv-vr(j,m(1)))
130 END DO
131 IF(itherm_fe > 0)
132 . temp(m(1))=half*(temp(na)+temp(nb))
133 END IF
134
135 IF(tagnod(m(2))==0)THEN
136 tagnod(m(2))=1
137 na=min(n2,n3)
138 nb=max(n2,n3)
139 DO j=1,3
140 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
141 a(j,m(2))=usdt*(vv-v(j,m(2)))
142 END DO
143 DO j=1,3
144 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
145 ar(j,m(2))=usdt*(vv-vr(j,m(2)))
146 END DO
147 IF(itherm_fe > 0)
148 . temp(m(2))=half*(temp(na)+temp(nb))
149 END IF
150
151 IF(tagnod(m(3))==0)THEN
152 tagnod(m(3))=1
153 na=min(n3,n4)
154 nb=max(n3,n4)
155 DO j=1,3
156 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
157 a(j,m(3))=usdt*(vv-v(j,m(3)))
158 END DO
159 DO j=1,3
160 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
161 ar(j,m(3))=usdt*(vv-vr(j,m(3)))
162 END DO
163 IF(itherm_fe > 0)
164 . temp(m(3))=half*(temp(na)+temp(nb))
165 END IF
166
167 IF(tagnod(m(4))==0)THEN
168 tagnod(m(4))=1
169 na=min(n4,n1)
170 nb=max(n4,n1)
171 DO j=1,3
172 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
173 a(j,m(4))=usdt*(vv-v(j,m(4)))
174 END DO
175 DO j=1,3
176 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
177 ar(j,m(4))=usdt*(vv-vr(j,m(4)))
178 END DO
179 IF(itherm_fe > 0)
180 . temp(m(4))=half*(temp(na)+temp(nb))
181 END IF
182 END DO
183
184 ll=psh3kin(level+1)-psh3kin(level)
185 sh3ft = psh3kin(level)+ 1+itask*ll/ nthread
186 sh3lt = psh3kin(level)+ (itask+1)*ll/nthread
187
188 DO nn=sh3ft,sh3lt
189 n =lsh3kin(nn)
190C
191 n1=ixtg(2,n)
192 n2=ixtg(3,n)
193 n3=ixtg(4,n)
194C
195 son=sh3tree(2,n)
196C
197 m(1)=ixtg(4,son+3)
198 m(2)=ixtg(2,son+3)
199 m(3)=ixtg(3,son+3)
200
201 IF(tagnod(m(1))==0)THEN
202 tagnod(m(1))=1
203 na=min(n1,n2)
204 nb=max(n1,n2)
205 DO j=1,3
206 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
207 a(j,m(1))=usdt*(vv-v(j,m(1)))
208 END DO
209 DO j=1,3
210 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
211 ar(j,m(1))=usdt*(vv-vr(j,m(1)))
212 END DO
213 IF(itherm_fe > 0)
214 . temp(m(1))=half*(temp(na)+temp(nb))
215 END IF
216
217 IF(tagnod(m(2))==0)THEN
218 tagnod(m(2))=1
219 na=min(n2,n3)
220 nb=max(n2,n3)
221 DO j=1,3
222 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
223 a(j,m(2))=usdt*(vv-v(j,m(2)))
224 END DO
225 DO j=1,3
226 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
227 ar(j,m(2))=usdt*(vv-vr(j,m(2)))
228 END DO
229 IF(itherm_fe > 0)
230 . temp(m(2))=half*(temp(na)+temp(nb))
231 END IF
232
233 IF(tagnod(m(3))==0)THEN
234 tagnod(m(3))=1
235 na=min(n3,n1)
236 nb=max(n3,n1)
237 DO j=1,3
238 vv= half*(v(j,na)+v(j,nb)+dt12*(a(j,na)+a(j,nb)))
239 a(j,m(3))=usdt*(vv-v(j,m(3)))
240 END DO
241 DO j=1,3
242 vv= half*(vr(j,na)+vr(j,nb)+dt12*(ar(j,na)+ar(j,nb)))
243 ar(j,m(3))=usdt*(vv-vr(j,m(3)))
244 END DO
245 IF(itherm_fe > 0)
246 . temp(m(3))=half*(temp(na)+temp(nb))
247 END IF
248 END DO
249C
250 CALL my_barrier
251C
252 END DO
253C
254 RETURN
255 END
admvit
subroutine admvit(ixc, ipartc, ixtg, iparttg, ipart, itask, a, v, ar, vr, sh4tree, sh3tree, temp, itherm_fe)
Definition admvit.F:35
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
remesh_mod
Definition remesh_mod.F:50
remesh_mod::lsh4kin
integer, dimension(:), allocatable lsh4kin
Definition remesh_mod.F:62
remesh_mod::lsh3kin
integer, dimension(:), allocatable lsh3kin
Definition remesh_mod.F:62
remesh_mod::psh4kin
integer, dimension(:), allocatable psh4kin
Definition remesh_mod.F:62
remesh_mod::psh3kin
integer, dimension(:), allocatable psh3kin
Definition remesh_mod.F:62
remesh_mod::tagnod
integer, dimension(:), allocatable tagnod
Definition remesh_mod.F:77
my_barrier
subroutine my_barrier
Definition machine.F:31