OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
int18_law151_update.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "com01_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine int18_law151_update (itask, multi_fvm, igrbric, ipari, ixs, igroups, iparg, elbuf_tab, force_int, x, v, ms, kinet, x_append, v_append, mass_append, kinet_append)

Function/Subroutine Documentation

◆ int18_law151_update()

subroutine int18_law151_update ( integer, intent(in) itask,
type(multi_fvm_struct) multi_fvm,
type (group_), dimension(ngrbric), intent(in) igrbric,
integer, dimension(npari,*), intent(in) ipari,
integer, dimension(nixs, *), intent(in) ixs,
integer, dimension(numels), intent(in) igroups,
integer, dimension(nparg,*), intent(in) iparg,
type (elbuf_struct_), dimension(ngroup), intent(in) elbuf_tab,
intent(inout) force_int,
intent(in) x,
intent(in) v,
intent(in) ms,
integer, dimension(*), intent(in) kinet,
intent(inout) x_append,
intent(inout) v_append,
intent(inout) mass_append,
integer, dimension(*), intent(inout) kinet_append )

Definition at line 35 of file int18_law151_update.F.

39!$COMMENT
40! INT18_LAW151_UPDATE description
41! mass/position/velocity update
42!
43! INT18_LAW151_UPDATE organization :
44! - // with openmp
45! - update of the element buffer is mandatory (for 2nd order scheme)
46! - force_int array needs to be flush to 0 for the next cycle
47!$ENDCOMMENT
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE multi_fvm_mod
52 USE groupdef_mod
53 USE elbufdef_mod
54 use element_mod , only : nixs
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59#include "comlock.inc"
60#include "com04_c.inc"
61#include "param_c.inc"
62#include "task_c.inc"
63#include "com01_c.inc"
64#include "parit_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER, INTENT(in) :: ITASK
69 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), INTENT(in) :: ELBUF_TAB
70 INTEGER, DIMENSION(NUMELS), INTENT(in) ::IGROUPS
71 INTEGER, DIMENSION(NPARG,*), INTENT(in) ::IPARG
72
73 INTEGER, DIMENSION(NPARI,*), INTENT(in) :: IPARI
74 my_real, DIMENSION(3,*), INTENT(in) :: x,v
75 my_real, DIMENSION(3,*), INTENT(inout) :: x_append,v_append
76 my_real, DIMENSION(*), INTENT(in) :: ms
77 INTEGER, DIMENSION(*), INTENT(in) :: KINET
78 my_real, DIMENSION(*), INTENT(inout) :: mass_append
79 INTEGER, DIMENSION(*), INTENT(inout) :: KINET_APPEND
80 my_real, DIMENSION(3,*), INTENT(inout) :: force_int
81 INTEGER, DIMENSION(NIXS, *), INTENT(in) :: IXS
82 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
83 TYPE (GROUP_) , DIMENSION(NGRBRIC), INTENT(in) :: IGRBRIC
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER :: I,J
88 INTEGER :: N,NN,II,JJ
89 INTEGER :: NFT,GROUP_ID,ILOC,NEL
90 INTEGER :: ISU1,NBRIC,NSN,NODE_ID,IBRIC
91 INTEGER :: NODF,NODL,NSNF,NSNL
92 my_real :: mass
93 my_real, DIMENSION(3) :: local_force_int
94 REAL(kind=8), dimension(3) :: local_force_int_dp
95 ! parith/on array
96 INTEGER, DIMENSION(NTHREAD) :: INDEX_THREADS
97 my_real, DIMENSION(:), ALLOCATABLE, SAVE :: vel
98 REAL(kind=8), dimension(:,:), ALLOCATABLE, SAVE :: vel_dp
99C-----------------------------------------------
100 nodf = 1 + itask * numnod / nthread
101 nodl = (1 + itask) * numnod / nthread
102
103 ! 1:NUMNOD --> classical x/v/mass
104 x_append(1:3,nodf:nodl) = x(1:3,nodf:nodl) !structure nodes must also be updated
105 v_append(1:3,nodf:nodl) = v(1:3,nodf:nodl)
106 mass_append(nodf:nodl) = ms(nodf:nodl)
107 kinet_append(nodf:nodl) = kinet(nodf:nodl)
108
109 CALL my_barrier()
110 ! -------------------------------------
111 ! update of vel array : parith/on part
112 IF(iparit/=0) THEN
113 DO nn=1,multi_fvm%NUMBER_INT18
114 n = multi_fvm%INT18_LIST(nn)
115 isu1 = ipari(45,n)
116 nbric = igrbric(isu1)%NENTITY
117 nsn = ipari(5,n) ! number of secondary nodes
118 nsnf = 1 + itask * nsn / nthread
119 nsnl = (1 + itask) * nsn / nthread
120
121 DO i = 1,nthread
122 index_threads(i) = 1 + 3*(i-1)*nsn/nthread
123 ENDDO
124!$OMP SINGLE
125 ALLOCATE( vel(3*nsn) )
126 ALLOCATE( vel_dp(6,3*nsn) )
127 DO ii = 1,nsn
128 ibric = igrbric(isu1)%ENTITY(ii) ! id of the phantom element
129 group_id = igroups(ibric) ! id of the element group
130 nft = iparg(3,group_id) ! first elem of the group
131 nel=iparg(2,group_id) ! number of element of the group
132 iloc = ibric - nft
133
134 vel_dp(1:6,(ii-1)+1) = multi_fvm%FORCE_INT_PON(1,1:6,ibric)
135 vel_dp(1:6,(ii-1)+2) = multi_fvm%FORCE_INT_PON(2,1:6,ibric)
136 vel_dp(1:6,(ii-1)+3) = multi_fvm%FORCE_INT_PON(3,1:6,ibric)
137
138 multi_fvm%FORCE_INT_PON(1,1:6,ibric) = 0.d+00
139 multi_fvm%FORCE_INT_PON(2,1:6,ibric) = 0.d+00
140 multi_fvm%FORCE_INT_PON(3,1:6,ibric) = 0.d+00
141
142 DO j=2,nthread
143 vel_dp(1:6,(ii-1)+1) = vel_dp(1:6,(ii-1)+1) + multi_fvm%FORCE_INT_PON(1,1:6,ibric+(j-1)*numels)
144 vel_dp(1:6,(ii-1)+2) = vel_dp(1:6,(ii-1)+2) + multi_fvm%FORCE_INT_PON(2,1:6,ibric+(j-1)*numels)
145 vel_dp(1:6,(ii-1)+3) = vel_dp(1:6,(ii-1)+3) + multi_fvm%FORCE_INT_PON(3,1:6,ibric+(j-1)*numels)
146 multi_fvm%FORCE_INT_PON(1:3,1:6,ibric+(j-1)*numels) = 0.d+00
147 ENDDO
148
149 mass = elbuf_tab(group_id)%GBUF%RHO(iloc) * elbuf_tab(group_id)%GBUF%VOL(iloc)
150
151 local_force_int_dp(1) = vel_dp(1,(ii-1)+1)
152 local_force_int_dp(2) = vel_dp(1,(ii-1)+2)
153 local_force_int_dp(3) = vel_dp(1,(ii-1)+3)
154 DO j=2,6
155 local_force_int_dp(1) = local_force_int_dp(1) + vel_dp(j,(ii-1)+1)
156 local_force_int_dp(2) = local_force_int_dp(2) + vel_dp(j,(ii-1)+2)
157 local_force_int_dp(3) = local_force_int_dp(3) + vel_dp(j,(ii-1)+3)
158 ENDDO
159 local_force_int_dp(1:3) = local_force_int_dp(1:3) / mass
160 multi_fvm%VEL(1:3,ibric) = multi_fvm%VEL(1:3,ibric) + local_force_int_dp(1:3)
161 ENDDO
162
163 DEALLOCATE( vel )
164 DEALLOCATE( vel_dp )
165!$OMP END SINGLE
166 ENDDO
167 ! -------------------------------------
168 ! update of vel array : parith/off part
169 ELSE
170 DO nn=1,multi_fvm%NUMBER_INT18
171 n = multi_fvm%INT18_LIST(nn)
172 isu1 = ipari(45,n)
173 nbric = igrbric(isu1)%NENTITY
174 nsn = ipari(5,n) ! number of secondary nodes
175 nsnf = 1 + itask * nsn / nthread
176 nsnl = (1 + itask) * nsn / nthread
177 DO ii = nsnf,nsnl
178 ibric = igrbric(isu1)%ENTITY(ii) ! id of the phantom element
179 group_id = igroups(ibric) ! id of the element group
180 nft = iparg(3,group_id) ! first elem of the group
181 nel=iparg(2,group_id) ! number of element of the group
182 iloc = ibric - nft
183 ! mass
184 mass = elbuf_tab(group_id)%GBUF%RHO(iloc) * elbuf_tab(group_id)%GBUF%VOL(iloc)
185 local_force_int(1:3) = zero
186 DO jj=1,nthread
187 local_force_int(1:3) = local_force_int(1:3) + force_int(1:3, ibric+(jj-1)*numels)
188 ENDDO
189
190 multi_fvm%VEL(1:3, ibric) = multi_fvm%VEL(1:3, ibric) + local_force_int(1:3) / mass
191
192 ! initialization of FORCE_INT for the next cycle
193 DO jj=1,nthread
194 force_int(1:3, ibric+(jj-1)*numels) = zero
195 ENDDO
196 ENDDO
197 ENDDO
198 ENDIF
199 ! -------------------------------------
200
201
202 ! NUMNOD+1:NUMNOD+NUMELS --> x/v/mass of phantom nodes (located to the center of
203 ! the ALE elements)
204 ! x_phantom = sum( 1/8 * x(i), i=1,8)
205
206 DO nn=1,multi_fvm%NUMBER_INT18
207 n = multi_fvm%INT18_LIST(nn)
208 isu1 = ipari(45,n)
209 nbric = igrbric(isu1)%NENTITY
210 nsn = ipari(5,n) ! number of secondary nodes
211 nsnf = 1 + itask * nsn / nthread
212 nsnl = (1 + itask) * nsn / nthread
213 DO ii = nsnf,nsnl
214 ibric = igrbric(isu1)%ENTITY(ii) ! id of the phantom element
215 group_id = igroups(ibric) ! id of the element group
216 nft = iparg(3,group_id) ! first elem of the group
217 nel=iparg(2,group_id) ! number of element of the group
218 iloc = ibric - nft
219 ! mass
220 mass = elbuf_tab(group_id)%GBUF%RHO(iloc) * elbuf_tab(group_id)%GBUF%VOL(iloc)
221 mass_append(numnod + ibric) = zero!MASS
222 ! position
223 IF(iale /= 0) THEN
224 x_append(1, numnod + ibric) = zero
225 x_append(2, numnod + ibric) = zero
226 x_append(3, numnod + ibric) = zero
227 DO jj = 2, 9
228 node_id = ixs(jj, ibric) ! id of node of the phantom element
229 x_append(1, numnod + ibric) = x_append(1, numnod + ibric) + one_over_8 * x(1, node_id)
230 x_append(2, numnod + ibric) = x_append(2, numnod + ibric) + one_over_8 * x(2, node_id)
231 x_append(3, numnod + ibric) = x_append(3, numnod + ibric) + one_over_8 * x(3, node_id)
232 ENDDO
233 ENDIF
234 ! --------------------------
235 ! velocity
236 v_append(1, numnod + ibric) = multi_fvm%VEL(1, ibric)
237 v_append(2, numnod + ibric) = multi_fvm%VEL(2, ibric)
238 v_append(3, numnod + ibric) = multi_fvm%VEL(3, ibric)
239
240 ! update the element buffer
241 elbuf_tab(group_id)%GBUF%MOM(iloc+0*nel)= multi_fvm%VEL(1, ibric)
242 elbuf_tab(group_id)%GBUF%MOM(iloc+1*nel)= multi_fvm%VEL(2, ibric)
243 elbuf_tab(group_id)%GBUF%MOM(iloc+2*nel)= multi_fvm%VEL(3, ibric)
244 ENDDO
245 ENDDO
246
247 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
groupdef_mod
Definition groupdef_mod.F:668
my_barrier
subroutine my_barrier
Definition machine.F:31