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,myop,
62 . KK, L, J, NIN, REQ,
63 . STATUS(MPI_STATUS_SIZE),type_reduc
64 parameter(i_len = 46)
65 my_real
66 . sbuf(nintc*i_len), rbuf(nintc*i_len)
67 INTEGER :: MESSAGE_LEN
68 my_real sbuf3(nintc), rbuf3(nintc)
69 INTEGER SBUF2(NINTC), RBUF2(NINTC)
70
71 INTEGER :: I17 !Number of TYPE17 interface
72
73C-----------------------------------------------
74C S o u r c e L i n e s
75C-----------------------------------------------
76C
77 sbuf3(1:nintc) = zero
78 sbuf2(1:nintc) = 0
79
80
81 i17 = 0
82 loc_proc = ispmd+1
83 IF(ircvfrom(ninter+1,loc_proc)>0.OR.
84 + isendto(ninter+1,loc_proc)>0) THEN
85
86C Pack original data
87 l = 0
88 DO kk=1,nintc
89 nin = intlist(kk)
90C X MIN/MAX
91 DO j=1,18
92 IF(mod((j-1)/3,2) == 0) THEN
93 sbuf(l+j) = xslv_l(j,nin)
94 ELSE
95 sbuf(l+j) =-xslv_l(j,nin)
96 ENDIF
97 END DO
98 l = l + 18
99C
100 DO j=1,12
101 IF(mod((j-1)/3,2) == 0) THEN
102 sbuf(l+j) = xmsr_l(j,nin)
103 ELSE
104 sbuf(l+j) =-xmsr_l(j,nin)
105 ENDIF
106 END DO
107 l = l + 12
108C V MIN/MAX
109 DO j=1,6
110 IF(mod((j-1)/3,2) == 0) THEN
111 sbuf(l+j) = vslv_l(j,nin)
112 ELSE
113 sbuf(l+j) =-vslv_l(j,nin)
114 ENDIF
115 END DO
116 l = l + 6
117C
118 DO j=1,6
119 IF(mod((j-1)/3,2) == 0) THEN
120 sbuf(l+j) = vmsr_l(j,nin)
121 ELSE
122 sbuf(l+j) = -vmsr_l(j,nin)
123 ENDIF
124 END DO
125 l = l + 6
126
127 IF(ipari(7,nin)/=17)THEN
128C NEWFRONT
129 sbuf(l+1) = -newfront(nin)
130 sbuf2(kk) = newfront(nin)
131 sbuf3(kk) = 0
132 ELSE ! interface 17 avec courbure
133
134 sbuf(l+1) = zero
135C SIZE
136 sbuf3(kk) = size_t(nin)
137 i17 = i17+1
138 END IF
139 l = l + 1
140C TZINF
141 sbuf(l+1) = -tzinf(kk)
142 l = l + 1
143C DELTA_PMAX_GAP
144 sbuf(l+1) = delta_pmax_gap(nin)
145 l = l + 1
146C T25 main gap changes with thickness change
147 sbuf(l+1) = maxdgap(nin)
148 l = l + 1
149 END DO
150 message_len = nintc * i_len
151 call mpi_allreduce(sbuf, rbuf, message_len, real , mpi_max,
152 & comm_cont, ierror)
153C MESSAGE_LEN = NINTC
154C call MPI_AllReduce(SBUF2, RBUF2, MESSAGE_LEN, MPI_INTEGER , MPI_SUM,
155C & COMM_CONT, ierror)
156
157 IF(i17 > 0) THEN
158 message_len = nintc
159 call mpi_allreduce(sbuf3, rbuf3, message_len, real , mpi_sum,
160 & comm_cont, ierror)
161 ENDIF
162
163 l = 0
164 DO kk=1,nintc
165 nin = intlist(kk)
166 IF(ircvfrom(nin,loc_proc)/=0.OR.
167 + isendto(nin,loc_proc)/=0)THEN
168 DO j=1,18
169 IF(mod((j-1)/3,2) == 0) THEN
170 xslv_l(j,nin) = rbuf(l+j)
171 ELSE
172 xslv_l(j,nin) =-rbuf(l+j)
173 ENDIF
174 END DO
175 l = l + 18
176 DO j=1,12
177 IF(mod((j-1)/3,2) == 0) THEN
178 xmsr_l(j,nin) = rbuf(l+j)
179 ELSE
180 xmsr_l(j,nin) =-rbuf(l+j)
181 ENDIF
182 END DO
183 l = l + 12
184 DO j=1,6
185 IF(mod((j-1)/3,2) == 0) THEN
186 vslv_l(j,nin) = rbuf(l+j)
187 ELSE
188 vslv_l(j,nin) =-rbuf(l+j)
189 ENDIF
190 END DO
191 l = l + 6
192 DO j=1,6
193 IF(mod((j-1)/3,2) == 0) THEN
194 vmsr_l(j,nin) = rbuf(l+j)
195 ELSE
196 vmsr_l(j,nin) = -rbuf(l+j)
197 ENDIF
198 END DO
199 l = l + 6
200 IF(ipari(7,nin)/=17)THEN
201 newfront(nin) = - nint(rbuf(l+1))
202 ELSE ! interface 17 avec courbure
203 size_t(nin) = rbuf3(kk)
204 END IF
205 l = l + 1
206 tzinf(kk) = -rbuf(l+1)
207 l = l + 1
208 delta_pmax_gap(nin) = rbuf(l+1)
209 l = l + 1
210C T25 main gap changes with thickness change
211 maxdgap(nin) = rbuf(l+1)
212 l = l + 1
213 ELSE
214 l = l + i_len
215 END IF
216 END DO
217
218 END IF
219
220
221#endif
222 RETURN
223 END
intcrit
subroutine intcrit(timers, errors, ipari, newfront, isendto, nsensor, ircvfrom, dt2t, neltst, ityptst, itab, xslv, xmsr, vslv, vmsr, intlist, nbintc, size_t, sensor_tab, delta_pmax_gap, intbuf_tab, delta_pmax_gap_node, idel7nok_sav, maxdgap, v)
Definition intcrit.F:49
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