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 34 of file int18_law151_update.F.

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