OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r2r_getdata.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!|| r2r_getdata ../engine/source/coupling/rad2rad/r2r_getdata.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| get_displ_c ../engine/source/coupling/rad2rad/rad2rad_c.c
29!|| get_displ_spmd ../engine/source/coupling/rad2rad/r2r_getdata.F
30!|| get_force_c ../engine/source/coupling/rad2rad/rad2rad_c.c
31!|| get_force_nl_c ../engine/source/coupling/rad2rad/rad2rad_c.c
32!|| get_force_spmd ../engine/source/coupling/rad2rad/r2r_getdata.F
33!|| spmd_exch_r2r_2 ../engine/source/mpi/r2r/spmd_r2r.F
34!|| spmd_exch_r2r_nl ../engine/source/mpi/r2r/spmd_exch_r2r_nl.F
35!|| spmd_exch_work ../engine/source/mpi/r2r/spmd_r2r.F
36!||--- uses -----------------------------------------------------
37!|| groupdef_mod ../common_source/modules/groupdef_mod.F
38!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
39!|| rad2r_mod ../engine/share/modules/rad2r.F
40!||====================================================================
41 SUBROUTINE r2r_getdata(
42 . IEXLNK ,IGRNOD ,X ,V ,
43 . VR ,A ,AR ,MS ,IN ,
44 . XDP ,DX ,R2R_ON ,DD_R2R ,WEIGHT ,
45 . IAD_ELEM,FR_ELEM ,STIFN , STIFR , DD_R2R_ELEM,
46 . SDD_R2R_ELEM,NLOC_DMG,WFEXT, WFEXT_MD)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE rad2r_mod
51 USE groupdef_mod
52 USE nlocal_reg_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "com06_c.inc"
63#include "com08_c.inc"
64#include "param_c.inc"
65#include "scr05_c.inc"
66#include "task_c.inc"
67#include "rad2r_c.inc"
68C-----------------------------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER R2R_ON
72 INTEGER IEXLNK(NR2R,NR2RLNK),
73 . WEIGHT(*), DD_R2R(NSPMD+1,*), IAD_ELEM(2,*), FR_ELEM(*),
74 . DD_R2R_ELEM(*),SDD_R2R_ELEM
75 my_real X(3,*),V(3,*),VR(3,*),A(3,*),AR(3,*),MS(*),IN(*),STIFN(*),STIFR(*),DX(3,*)
76
77 DOUBLE PRECISION XDP(3,*)
78 TYPE (GROUP_) , TARGET, DIMENSION(NGRNOD) :: IGRNOD
79 TYPE(NLOCAL_STR_), TARGET, INTENT(IN) :: NLOC_DMG
80 DOUBLE PRECISION, INTENT(INOUT) :: WFEXT
81 DOUBLE PRECISION, INTENT(INOUT) :: WFEXT_MD !< specific to r2r method
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER I, IEX, IDP, IDG, NNG, NB,NGLOB,LENR,SIZE,BID
86 INTEGER NBD,NL_FLAG,SBUF_SIZE,RBUF_SIZE,PSP
87 my_real WF, WM, WF2, WM2, WFB, WMB, WF2B, WM2B,ANN,VNN,ARN,VRN
88 INTEGER, DIMENSION(:), POINTER :: GRNOD
89 my_real, POINTER, DIMENSION(:) :: MSNL,FNL
90C=======================================================================
91 wf = zero
92 wm = zero
93 wf2= zero
94 wm2= zero
95 nl_flag = 0
96
97 IF ((r2r_siu==1).OR.(nspmd==1)) THEN
98C-----------------------------------------------------------------------
99 DO iex = 1, nr2rlnk
100 idg = iexlnk(1,iex)
101 idp = iexlnk(2,iex)
102 nng = igrnod(idg)%NENTITY
103 grnod => igrnod(idg)%ENTITY
104
105 IF (nllnk(iex)==1) THEN
106C-------Non local coupling interface--------------------------
107 nl_flag = 1
108 msnl => nloc_dmg%MASS(1:nloc_dmg%L_NLOC)
109 fnl => nloc_dmg%FNL(1:nloc_dmg%L_NLOC,1)
110 CALL get_force_nl_c(idp ,nbdof_nl(iex) ,iadd_nl ,fnl ,msnl ,
111 . iex)
112 ELSE
113 CALL get_force_c(idp ,nng ,grnod ,wf ,wm ,
114 . wf2 ,wm2 ,v ,vr ,a ,ar ,
115 . ms ,in ,x ,xdp ,dx ,typlnk(iex),
116 . kinlnk(iex),weight ,iex ,iresp, wfext)
117 ENDIF
118C
119 IF (r2r_on == 1) THEN
120 CALL get_displ_c(idp,nng,grnod,x)
121 ENDIF
122 END DO
123
124C----------New rad2rad HMPP - synchro SPMD-----------------------------
125 IF (nspmd>1) THEN
126 IF (sdd_r2r_elem>0) THEN
127 IF (nl_flag == 0) THEN
128 SIZE = 3+flag_kine + iroddl*(3+flag_kine)
129 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
130 CALL spmd_exch_r2r_2(a ,ar,v , vr ,ms ,in,
131 2 iad_elem,fr_elem,SIZE , wf, wf2,
132 3 lenr ,dd_r2r,dd_r2r_elem,weight,flag_kine)
133 ELSE
134 SIZE = 3+flag_kine + iroddl*(3+flag_kine)
135 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
136 sbuf_size = size*lenr + dd_r2r_nl(1)
137 rbuf_size = size*lenr + dd_r2r_nl(2)
138 CALL spmd_exch_r2r_nl(a ,ar,v , vr ,ms ,
139 2 in,iad_elem,fr_elem,SIZE ,
140 3 sbuf_size,rbuf_size,wf, wf2,dd_r2r,
141 4 dd_r2r_elem,weight,flag_kine,nloc_dmg)
142 ENDIF
143 ENDIF
144 CALL spmd_exch_work(wf, wf2)
145 CALL spmd_exch_work(wm, wm2)
146 END IF
147C
148 ELSE
149C
150 DO iex = 1, nr2rlnk
151 idg = iexlnk(1,iex)
152 idp = iexlnk(2,iex)
153 nng = igrnod(idg)%NENTITY
154 grnod => igrnod(idg)%ENTITY
155C-
156 wfb = zero
157 wmb = zero
158 wf2b= zero
159 wm2b= zero
160C-
161 IF (ispmd==0) THEN
162 nglob=dd_r2r(nspmd+1,iex)+dbno(iex)
163 nb = dbno(iex)
164 ELSE
165 nglob=nng
166 nb = 0
167 ENDIF
168C-
169 nb = dbno(iex)
170 nbd = dd_r2r(nspmd+1,iex)
171
172 CALL get_force_spmd(
173 1 idp ,nng ,grnod,wfb,wmb ,
174 2 wf2b ,wm2b ,v ,vr,a ,
175 3 ar ,ms ,in,dd_r2r(1,iex),nglob,
176 4 weight ,iad_elem,fr_elem,nb,iex,typlnk(iex),rotlnk(iex),nbd)
177C-
178 wf = wf + wfb
179 wm = wm + wmb
180 wf2 = wf2 + wf2b
181 wm2 = wm2 + wm2b
182 IF (r2r_on == 1) THEN
183 CALL get_displ_spmd(
184 1 idp,nng ,grnod,x ,dd_r2r(1,iex),
185 2 nglob,weight ,iad_elem,fr_elem,iex)
186C-
187 ENDIF
188 END DO
189C
190 END IF
191
192C----- Count the work of external process forces
193 IF(ispmd==0) THEN
194 wfext_md = wfext_md + r2rfx1 + (wf + wm) * dt1
195 r2rfx1 = wf + wm
196 r2rfx2 = wf2 + wm2
197 END IF
198C
199C-----------------------------------------------------------------
200 RETURN
201 END SUBROUTINE r2r_getdata
202C
203!||====================================================================
204!|| get_force_spmd ../engine/source/coupling/rad2rad/r2r_getdata.F
205!||--- called by ------------------------------------------------------
206!|| r2r_getdata ../engine/source/coupling/rad2rad/r2r_getdata.F
207!||--- calls -----------------------------------------------------
208!|| get_force_spmd_c ../engine/source/coupling/rad2rad/rad2rad_c.c
209!|| spmd_r2r_rset3 ../engine/source/mpi/r2r/spmd_r2r.f
210!|| spmd_r2r_rset3b ../engine/source/mpi/r2r/spmd_r2r.F
211!||====================================================================
212 SUBROUTINE get_force_spmd(
213 1 IDP ,NNG ,GRNOD ,WF ,WM ,
214 2 WF2 ,WM2 ,V ,VR ,A ,
215 3 AR ,MS ,IN ,DD_R2R ,NGLOB,
216 4 WEIGHT ,IAD_ELEM,FR_ELEM,NB,IEX,TYP,FLAG_ROT,NBD)
217C----6------------------------------------------
218C I m p l i c i t T y p e s
219C-----------------------------------------------
220#include "implicit_f.inc"
221C-----------------------------------------------
222C C o m m o n B l o c k s
223C-----------------------------------------------
224#include "com01_c.inc"
225#include "task_c.inc"
226C-----------------------------------------------
227C D u m m y A r g u m e n t s
228C-----------------------------------------------
229 INTEGER IDP, NNG, NGLOB, GRNOD(*),IEX,NB,TYP,FLAG_ROT,
230 . WEIGHT(*), DD_R2R(*), IAD_ELEM(2,*), FR_ELEM(*),NBD
231C REAL
232 my_real
233 . V(3,*),VR(3,*),A(3,*),AR(3,*),MS(*),IN(*),
234 . WF, WM, WF2, WM2
235C-----------------------------------------------
236C L o c a l V a r i a b l e s
237C-----------------------------------------------
238 INTEGER LRBUF,i
239 my_real
240 . BUFR1(3,NGLOB),BUFR2(3,NGLOB),
241 . bufr3(3,nglob),bufr4(3,nglob),wtmp(4)
242 INTEGER POP0,POP1,RATE
243 my_real
244 . POP2,POP3,SECS
245C
246C******************************************************************************C
247
248 IF(ispmd==0) THEN
249 CALL get_force_spmd_c(idp,nbd,bufr1,bufr2,bufr3,bufr4,typ,iex,nglob)
250 ENDIF
251 lrbuf = 2*4*(iad_elem(1,nspmd+1)-iad_elem(1,1))+2*nspmd
252
253 IF (typ/=7) THEN
254 IF(flag_rot /= 0)THEN
255 IF(typ<4)THEN
256 CALL spmd_r2r_rset3(vr ,nng ,grnod,dd_r2r,weight,
257 . bufr4,iad_elem,fr_elem,lrbuf,iex)
258 ENDIF
259 CALL spmd_r2r_rset3b(ar ,nng ,grnod,dd_r2r,weight,
260 . bufr2,iad_elem,fr_elem,lrbuf, in, vr, wm, wm2,iex)
261 END IF
262
263 CALL spmd_r2r_rset3b(a ,nng ,grnod,dd_r2r,weight,
264 . bufr1,iad_elem,fr_elem,lrbuf, ms, v, wf, wf2,iex)
265 IF(typ<4)THEN
266 CALL spmd_r2r_rset3(v ,nng ,grnod,dd_r2r,weight,
267 . bufr3,iad_elem,fr_elem,lrbuf,iex)
268 ENDIF
269
270 wtmp(1) = wf
271 wtmp(2) = wf2
272 wtmp(3) = wm
273 wtmp(4) = wm2
274 wf = wtmp(1)
275 wf2 = wtmp(2)
276 wm = wtmp(3)
277 wm2 = wtmp(4)
278 ENDIF
279C-----------------------------------------------------------------
280 RETURN
281 END SUBROUTINE get_force_spmd
282C
283!||====================================================================
284!|| get_displ_spmd ../engine/source/coupling/rad2rad/r2r_getdata.F
285!||--- called by ------------------------------------------------------
286!|| r2r_getdata ../engine/source/coupling/rad2rad/r2r_getdata.F
287!||--- calls -----------------------------------------------------
288!|| get_displ_spmd_c ../engine/source/coupling/rad2rad/rad2rad_c.c
289!|| spmd_r2r_rset3 ../engine/source/mpi/r2r/spmd_r2r.F
290!||====================================================================
291 SUBROUTINE get_displ_spmd(
292 1 IDP ,NNG ,GRNOD ,X ,DD_R2R ,
293 4 NGLOB,WEIGHT,IAD_ELEM,FR_ELEM,IEX )
294C-----------------------------------------------
295C I m p l i c i t T y p e s
296C-----------------------------------------------
297#include "implicit_f.inc"
298C-----------------------------------------------
299C C o m m o n B l o c k s
300C-----------------------------------------------
301#include "com01_c.inc"
302#include "task_c.inc"
303C-----------------------------------------------
304C D u m m y A r g u m e n t s
305C-----------------------------------------------
306 INTEGER IDP, NNG, NGLOB,IEX,GRNOD(*),
307 . WEIGHT(*), DD_R2R(*), IAD_ELEM(2,*), FR_ELEM(*)
308C REAL
309 my_real
310 . X(3,*)
311C-----------------------------------------------
312C L o c a l V a r i a b l e s
313C-----------------------------------------------
314 INTEGER LRBUF
315 my_real
316 . BUFR1(3,NGLOB)
317C
318C******************************************************************************C
319 IF(ispmd==0)
320 . CALL get_displ_spmd_c(idp,nglob,bufr1)
321 lrbuf = 2*4*iad_elem(1,nspmd+1)-iad_elem(1,1)+2*nspmd
322 CALL spmd_r2r_rset3(x ,nng ,grnod,dd_r2r,weight,
323 . bufr1,iad_elem,fr_elem,lrbuf,iex)
324
325C-----------------------------------------------------------------
326 RETURN
327 END SUBROUTINE get_displ_spmd
328C
329!||====================================================================
330!|| r2r_sendkine ../engine/source/coupling/rad2rad/r2r_getdata.F
331!||--- called by ------------------------------------------------------
332!|| resol ../engine/source/engine/resol.F
333!||--- calls -----------------------------------------------------
334!|| send_mass_kine_c ../engine/source/coupling/rad2rad/rad2rad_c.c
335!||--- uses -----------------------------------------------------
336!|| groupdef_mod ../common_source/modules/groupdef_mod.F
337!|| rad2r_mod ../engine/share/modules/rad2r.F
338!||====================================================================
339 SUBROUTINE r2r_sendkine(
340 . IEXLNK ,IGRNOD ,MS ,IN)
341C-----------------------------------------------
342C M o d u l e s
343C-----------------------------------------------
344 USE rad2r_mod
345 USE groupdef_mod
346C-----------------------------------------------
347C I m p l i c i t T y p e s
348C-----------------------------------------------
349#include "implicit_f.inc"
350C-----------------------------------------------
351C C o m m o n B l o c k s
352C-----------------------------------------------
353#include "com04_c.inc"
354#include "param_c.inc"
355#include "rad2r_c.inc"
356C-----------------------------------------------
357C D u m m y A r g u m e n t s
358C-----------------------------------------------
359 INTEGER IEXLNK(NR2R,NR2RLNK)
360 my_real MS(*),IN(*)
361!
362 TYPE (GROUP_) , TARGET, DIMENSION(NGRNOD) :: IGRNOD
363C-----------------------------------------------
364C L o c a l V a r i a b l e s
365C-----------------------------------------------
366 INTEGER I, IEX, IDP, IDG, NNG, OFF
367C
368 INTEGER, DIMENSION(:), POINTER :: GRNOD
369C=======================================================================
370
371 flag_kine = 0
372 off = 0
373
374 IF (r2r_siu==1) THEN
375C----------Send of new mass---------------------------------------
376 DO iex = 1, nr2rlnk
377 idp = iexlnk(2,iex)
378 idg = iexlnk(1,iex)
379 nng = igrnod(idg)%NENTITY
380 grnod => igrnod(idg)%ENTITY
381 IF ((typlnk(iex)==5).AND.(kinlnk(iex)==1)) THEN
382 flag_kine = 1
383 CALL send_mass_kine_c(idp,nng,grnod,ms,in,iex,off)
384 ENDIF
385 off = off + nng
386 END DO
387 ENDIF
388
389C-----------------------------------------------------------------
390 RETURN
391 END SUBROUTINE r2r_sendkine
groupdef_mod
Definition groupdef_mod.F:662
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
rad2r_mod
Definition rad2r.F:46
rad2r_mod::nllnk
integer, dimension(:), allocatable nllnk
Definition rad2r.F:53
rad2r_mod::nbdof_nl
integer, dimension(:), allocatable nbdof_nl
Definition rad2r.F:53
rad2r_mod::rotlnk
integer, dimension(:), allocatable rotlnk
Definition rad2r.F:53
rad2r_mod::iadd_nl
integer, dimension(:), allocatable iadd_nl
Definition rad2r.F:53
rad2r_mod::dd_r2r_nl
integer, dimension(2) dd_r2r_nl
Definition rad2r.F:64
rad2r_mod::typlnk
integer, dimension(:), allocatable typlnk
Definition rad2r.F:53
rad2r_mod::kinlnk
integer, dimension(:), allocatable kinlnk
Definition rad2r.F:53
rad2r_mod::dbno
integer, dimension(:), allocatable dbno
Definition rad2r.F:53
get_force_spmd
subroutine get_force_spmd(idp, nng, grnod, wf, wm, wf2, wm2, v, vr, a, ar, ms, in, dd_r2r, nglob, weight, iad_elem, fr_elem, nb, iex, typ, flag_rot, nbd)
Definition r2r_getdata.F:217
r2r_getdata
subroutine r2r_getdata(iexlnk, igrnod, x, v, vr, a, ar, ms, in, xdp, dx, r2r_on, dd_r2r, weight, iad_elem, fr_elem, stifn, stifr, dd_r2r_elem, sdd_r2r_elem, nloc_dmg, wfext, wfext_md)
Definition r2r_getdata.F:47
get_displ_spmd
subroutine get_displ_spmd(idp, nng, grnod, x, dd_r2r, nglob, weight, iad_elem, fr_elem, iex)
Definition r2r_getdata.F:294
r2r_sendkine
subroutine r2r_sendkine(iexlnk, igrnod, ms, in)
Definition r2r_getdata.F:341
send_mass_kine_c
void send_mass_kine_c(int *idp, int *nng, int *nodbuf, my_real_c *ms, my_real_c *in, int *iex, int *offset)
Definition rad2rad_c.c:1960
get_force_c
void get_force_c(int *idp, int *nng, int *nodbuf, my_real_c *wf, my_real_c *wm, my_real_c *wf2, my_real_c *wm2, my_real_c *v, my_real_c *vr, my_real_c *fx, my_real_c *fr, my_real_c *ms, my_real_c *in, my_real_c *x, double *xdp, my_real_c *dx, int *typ, int *kin, int *wgt, int *iex, int *iresp, double *tfext)
Definition rad2rad_c.c:1738
get_displ_c
void get_displ_c(int *idp, int *nng, int *nodbuf, my_real_c *x)
Definition rad2rad_c.c:1992
get_displ_spmd_c
void get_displ_spmd_c(int *idp, int *nng, my_real_c *bufr)
Definition rad2rad_c.c:2030
get_force_spmd_c
void get_force_spmd_c(int *idp, int *nng, my_real_c *bufr1, my_real_c *bufr2, my_real_c *bufr3, my_real_c *bufr4, int *typ, int *iex, int *nglob)
Definition rad2rad_c.c:1892
get_force_nl_c
void get_force_nl_c(int *idp, int *nng, int *iadd_nl, my_real_c *fx, my_real_c *ms, int *iex)
Definition rad2rad_c.c:1859
spmd_exch_r2r_nl
subroutine spmd_exch_r2r_nl(a, ar, v, vr, ms, in, iad_elem, fr_elem, size, sbuf_size, rbuf_size, wf, wf2, dd_r2r, dd_r2r_elem, weight, flag, nloc_dmg)
Definition spmd_exch_r2r_nl.F:37
spmd_exch_work
subroutine spmd_exch_work(wf, wf2)
Definition spmd_r2r.F:1729
spmd_r2r_rset3b
subroutine spmd_r2r_rset3b(a, nng, grnod, dd_r2r, weight, bufr, iad_elem, fr_elem, lrbuf, ms, v, wf, wf2, iex)
Definition spmd_r2r.F:1040
spmd_r2r_rset3
subroutine spmd_r2r_rset3(a, nng, grnod, dd_r2r, weight, bufr, iad_elem, fr_elem, lrbuf, iex)
Definition spmd_r2r.F:942
spmd_exch_r2r_2
subroutine spmd_exch_r2r_2(a, ar, v, vr, ms, in, iad_elem, fr_elem, size, wf, wf2, lenr, dd_r2r, dd_r2r_elem, weight, flag)
Definition spmd_r2r.F:1361