OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admvit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "scr17_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine admvit (ixc, ipartc, ixtg, iparttg, ipart, itask, a, v, ar, vr, sh4tree, sh3tree, temp, itherm_fe)

Function/Subroutine Documentation

◆ admvit()

subroutine admvit ( integer, dimension(nixc,*) ixc,
integer, dimension(*) ipartc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) iparttg,
integer, dimension(lipart1,*) ipart,
integer itask,
a,
v,
ar,
vr,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
temp,
integer, intent(in) itherm_fe )

Definition at line 33 of file admvit.F.

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