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