OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_sync_mmxg2.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_sync_mmxg2 ../engine/source/mpi/interfaces/spmd_sync_mmxg2.F
26!||--- called by ------------------------------------------------------
27!|| intcrit ../engine/source/interfaces/intsort/intcrit.F
28!||--- calls -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE spmd_sync_mmxg2(
31 1 ISENDTO,IRCVFROM,NEWFRONT,XSLV_L,XMSR_L,
32 2 VSLV_L ,VMSR_L ,INTLIST ,NINTC ,TZINF ,
33 3 SIZE_T ,IPARI , DELTA_PMAX_GAP,MAXDGAP )
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------------------------
39C M e s s a g e P a s s i n g
40C-----------------------------------------------
41#include "spmd.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com04_c.inc"
46#include "param_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 ISENDTO(NINTER+1,*) ,IRCVFROM(NINTER+1,*),
52 . NEWFRONT(*), NINTC, INTLIST(*), IPARI(NPARI,*)
53 my_real
54 . xslv_l(18,*), xmsr_l(12,*), vslv_l(6,*),
55 . vmsr_l(6,*), tzinf(*), size_t(*),delta_pmax_gap(*),
56 . maxdgap(ninter)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60#ifdef MPI
61 INTEGER LOC_PROC, IERROR, I_LEN,
62 . KK, L, J, NIN
63 PARAMETER (I_LEN = 46)
64 my_real
65 . sbuf(nintc*i_len), rbuf(nintc*i_len)
66 INTEGER :: MESSAGE_LEN
67 my_real sbuf3(nintc), rbuf3(nintc)
68 INTEGER SBUF2(NINTC)
69
70 INTEGER :: I17 !Number of TYPE17 interface
71
72C-----------------------------------------------
73C S o u r c e L i n e s
74C-----------------------------------------------
75C
76 sbuf3(1:nintc) = zero
77 sbuf2(1:nintc) = 0
78
79
80 i17 = 0
81 loc_proc = ispmd+1
82 IF(ircvfrom(ninter+1,loc_proc)>0.OR.
83 + isendto(ninter+1,loc_proc)>0) THEN
84
85C Pack original data
86 l = 0
87 DO kk=1,nintc
88 nin = intlist(kk)
89C X MIN/MAX
90 DO j=1,18
91 IF(mod((j-1)/3,2) == 0) THEN
92 sbuf(l+j) = xslv_l(j,nin)
93 ELSE
94 sbuf(l+j) =-xslv_l(j,nin)
95 ENDIF
96 END DO
97 l = l + 18
98C
99 DO j=1,12
100 IF(mod((j-1)/3,2) == 0) THEN
101 sbuf(l+j) = xmsr_l(j,nin)
102 ELSE
103 sbuf(l+j) =-xmsr_l(j,nin)
104 ENDIF
105 END DO
106 l = l + 12
107C V MIN/MAX
108 DO j=1,6
109 IF(mod((j-1)/3,2) == 0) THEN
110 sbuf(l+j) = vslv_l(j,nin)
111 ELSE
112 sbuf(l+j) =-vslv_l(j,nin)
113 ENDIF
114 END DO
115 l = l + 6
116C
117 DO j=1,6
118 IF(mod((j-1)/3,2) == 0) THEN
119 sbuf(l+j) = vmsr_l(j,nin)
120 ELSE
121 sbuf(l+j) = -vmsr_l(j,nin)
122 ENDIF
123 END DO
124 l = l + 6
125
126 IF(ipari(7,nin)/=17)THEN
127C NEWFRONT
128 sbuf(l+1) = -newfront(nin)
129 sbuf2(kk) = newfront(nin)
130 sbuf3(kk) = 0
131 ELSE ! interface 17 with curvature
132
133 sbuf(l+1) = zero
134C SIZE
135 sbuf3(kk) = size_t(nin)
136 i17 = i17+1
137 END IF
138 l = l + 1
139C TZINF
140 sbuf(l+1) = -tzinf(kk)
141 l = l + 1
142C DELTA_PMAX_GAP
143 sbuf(l+1) = delta_pmax_gap(nin)
144 l = l + 1
145C T25 main gap changes with thickness change
146 sbuf(l+1) = maxdgap(nin)
147 l = l + 1
148 END DO
149 message_len = nintc * i_len
150 call mpi_allreduce(sbuf, rbuf, message_len, real , mpi_max,
151 & comm_cont, ierror)
152C MESSAGE_LEN = NINTC
153C call MPI_AllReduce(SBUF2, RBUF2, MESSAGE_LEN, MPI_INTEGER , MPI_SUM,
154C & COMM_CONT, ierror)
155
156 IF(i17 > 0) THEN
157 message_len = nintc
158 call mpi_allreduce(sbuf3, rbuf3, message_len, real , mpi_sum,
159 & comm_cont, ierror)
160 ENDIF
161
162 l = 0
163 DO kk=1,nintc
164 nin = intlist(kk)
165 IF(ircvfrom(nin,loc_proc)/=0.OR.
166 + isendto(nin,loc_proc)/=0)THEN
167 DO j=1,18
168 IF(mod((j-1)/3,2) == 0) THEN
169 xslv_l(j,nin) = rbuf(l+j)
170 ELSE
171 xslv_l(j,nin) =-rbuf(l+j)
172 ENDIF
173 END DO
174 l = l + 18
175 DO j=1,12
176 IF(mod((j-1)/3,2) == 0) THEN
177 xmsr_l(j,nin) = rbuf(l+j)
178 ELSE
179 xmsr_l(j,nin) =-rbuf(l+j)
180 ENDIF
181 END DO
182 l = l + 12
183 DO j=1,6
184 IF(mod((j-1)/3,2) == 0) THEN
185 vslv_l(j,nin) = rbuf(l+j)
186 ELSE
187 vslv_l(j,nin) =-rbuf(l+j)
188 ENDIF
189 END DO
190 l = l + 6
191 DO j=1,6
192 IF(mod((j-1)/3,2) == 0) THEN
193 vmsr_l(j,nin) = rbuf(l+j)
194 ELSE
195 vmsr_l(j,nin) = -rbuf(l+j)
196 ENDIF
197 END DO
198 l = l + 6
199 IF(ipari(7,nin)/=17)THEN
200 newfront(nin) = - nint(rbuf(l+1))
201 ELSE ! interface 17 with curvature
202 size_t(nin) = rbuf3(kk)
203 END IF
204 l = l + 1
205 tzinf(kk) = -rbuf(l+1)
206 l = l + 1
207 delta_pmax_gap(nin) = rbuf(l+1)
208 l = l + 1
209C T25 main gap changes with thickness change
210 maxdgap(nin) = rbuf(l+1)
211 l = l + 1
212 ELSE
213 l = l + i_len
214 END IF
215 END DO
216
217 END IF
218
219
220#endif
221 RETURN
222 END
mpi_allreduce
subroutine mpi_allreduce(sendbuf, recvbuf, cnt, datatype, operation, comm, ierr)
Definition mpi.f:103
spmd_sync_mmxg2
subroutine spmd_sync_mmxg2(isendto, ircvfrom, newfront, xslv_l, xmsr_l, vslv_l, vmsr_l, intlist, nintc, tzinf, size_t, ipari, delta_pmax_gap, maxdgap)
Definition spmd_sync_mmxg2.F:34