OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_rbe2_pon.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!|| spmd_exch_rbe2_pon ../engine/source/mpi/kinematic_conditions/spmd_exch_rbe2_pon.F
25!||--- called by ------------------------------------------------------
26!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
30!||====================================================================
31 SUBROUTINE spmd_exch_rbe2_pon(
32 1 A ,AR ,STIFN ,STIFR ,IAD_M ,
33 2 FR_M ,LCOMM ,ISIZE)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37 USE spmd_comm_world_mod, ONLY : spmd_comm_world
38#include "implicit_f.inc"
39C-----------------------------------------------
40C M e s s a g e P a s s i n g
41C-----------------------------------------------
42#include "spmd.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com01_c.inc"
47#include "task_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER LCOMM, ISIZE, FR_M(*), IAD_M(*)
52 DOUBLE PRECISION
53 . a(3,6,*), ar(3,6,*), stifn(6,*), stifr(6,*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57#ifdef MPI
58 INTEGER MSGTYP,LOC_PROC,NOD,I,J,L,IDEB,IAD,LEN,
59 . NBINDEX,INDEX,MSGOFF,SIZ,IERROR,K,
60 . status(mpi_status_size),isize6,
61 . req_s(nspmd),req_r(nspmd),indexi(nspmd),irot
62 DATA msgoff/211/
63 double precision
64 . sbuf(lcomm*isize*6), rbuf(lcomm*isize*6)
65C-----------------------------------------------
66C S o u r c e L i n e s
67C-----------------------------------------------
68 loc_proc = ispmd + 1
69 isize6=isize*6
70 irot = 0
71 IF (isize>4) irot=1
72C
73 ideb = 1
74 l = 0
75 DO i = 1, nspmd
76 len = iad_m(i+1)-iad_m(i)
77 IF(len>0) THEN
78 siz = len*isize6
79 l=l+1
80 indexi(l)=i
81 msgtyp = msgoff
82 CALL mpi_irecv(
83 s rbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
84 g spmd_comm_world,req_r(l),ierror)
85 ideb = ideb + siz
86 ENDIF
87 ENDDO
88 nbindex = l
89C
90 ideb = 1
91 DO l = 1, nbindex
92 i = indexi(l)
93 len = iad_m(i+1) - iad_m(i)
94 iad = iad_m(i)-1
95 IF (irot==0) THEN
96#include "vectorize.inc"
97 DO j = 1, len
98 nod = fr_m(iad+j)
99 DO k = 1, 6
100 sbuf(ideb) = a(1,k,nod)
101 sbuf(ideb+1) = a(2,k,nod)
102 sbuf(ideb+2) = a(3,k,nod)
103 sbuf(ideb+3) = stifn(k,nod)
104 ideb = ideb + isize
105 ENDDO
106 ENDDO
107 ELSE
108#include "vectorize.inc"
109 DO j = 1, len
110 nod = fr_m(iad+j)
111 DO k = 1, 6
112 sbuf(ideb) = a(1,k,nod)
113 sbuf(ideb+1) = a(2,k,nod)
114 sbuf(ideb+2) = a(3,k,nod)
115 sbuf(ideb+3) = ar(1,k,nod)
116 sbuf(ideb+4) = ar(2,k,nod)
117 sbuf(ideb+5) = ar(3,k,nod)
118 sbuf(ideb+6) = stifn(k,nod)
119 sbuf(ideb+7) = stifr(k,nod)
120 ideb = ideb + isize
121 ENDDO
122 ENDDO
123 ENDIF
124 ENDDO
125C
126 ideb = 1
127 DO l=1,nbindex
128 i = indexi(l)
129 len = iad_m(i+1)-iad_m(i)
130 siz = len*isize6
131 msgtyp = msgoff
132 CALL mpi_isend(
133 s sbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
134 g spmd_comm_world,req_s(l),ierror)
135 ideb = ideb + siz
136 ENDDO
137C
138 DO l=1,nbindex
139 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
140 i = indexi(index)
141 ideb = 1+(iad_m(i)-1)*isize6
142 len = iad_m(i+1)-iad_m(i)
143 iad = iad_m(i)-1
144 IF (irot==0) THEN
145#include "vectorize.inc"
146 DO j = 1, len
147 nod = fr_m(iad+j)
148 DO k = 1, 6
149 a(1,k,nod) = a(1,k,nod) + rbuf(ideb)
150 a(2,k,nod) = a(2,k,nod) + rbuf(ideb+1)
151 a(3,k,nod) = a(3,k,nod) + rbuf(ideb+2)
152 stifn(k,nod) = stifn(k,nod)+rbuf(ideb+3)
153 ideb = ideb + isize
154 ENDDO
155 ENDDO
156 ELSE
157#include "vectorize.inc"
158 DO j = 1, len
159 nod = fr_m(iad+j)
160 DO k = 1, 6
161 a(1,k,nod) = a(1,k,nod) + rbuf(ideb)
162 a(2,k,nod) = a(2,k,nod) + rbuf(ideb+1)
163 a(3,k,nod) = a(3,k,nod) + rbuf(ideb+2)
164 ar(1,k,nod) = ar(1,k,nod)+ rbuf(ideb+3)
165 ar(2,k,nod) = ar(2,k,nod)+ rbuf(ideb+4)
166 ar(3,k,nod) = ar(3,k,nod)+ rbuf(ideb+5)
167 stifn(k,nod) = stifn(k,nod)+rbuf(ideb+6)
168 stifr(k,nod) = stifr(k,nod)+rbuf(ideb+7)
169 ideb = ideb + isize
170 ENDDO
171 END DO
172 END IF
173 ENDDO
174C
175 DO l=1,nbindex
176 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
177 ENDDO
178C
179#endif
180 RETURN
181 END
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
spmd_exch_rbe2_pon
subroutine spmd_exch_rbe2_pon(a, ar, stifn, stifr, iad_m, fr_m, lcomm, isize)
Definition spmd_exch_rbe2_pon.F:34