OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_int18_law151_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!||====================================================================
25!|| spmd_int18_law151_pon ../engine/source/mpi/forces/spmd_int18_law151_pon.F
26!||--- called by ------------------------------------------------------
27!|| resol ../engine/source/engine/resol.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../engine/source/output/message/message.F
30!|| arret ../engine/source/system/arret.F
31!||--- uses -----------------------------------------------------
32!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
35!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
36!|| tri7box ../engine/share/modules/tri7box.F
37!||====================================================================
38 SUBROUTINE spmd_int18_law151_pon(
39 1 IPARI ,ISLEN7 ,IRLEN7 ,IFLAG ,INTBUF_TAB,
40 2 MULTI_FVM)
41!$COMMENT
42! SPMD_INT18_LAW151_PON description
43! communication of the remote values of the
44! phantom nodes
45!
46! SPMD_INT18_LAW151_PON organization :
47! part 1 = received part & send part :
48! - 6*3 values per phantom nodes
49! - 1 value for the number of send values (=nb)
50!
51! buffer (send & received) organization
52! | 1 | 2 | ... | 6 | 7 | 8 |... | nb | nb+1 | nb+2| ...
53! | nb1| x1 | | x1 | x1 | y1 |... | znb | nb2 | ...
54! |---------|-------------------------------|----------|---------------|
55! proc1 proc2
56!
57! part 2 = accumulation of received values in the local array
58!$ENDCOMMENT
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE tri7box
63 USE message_mod
64 USE intbufdef_mod
65 USE multi_fvm_mod
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69 USE spmd_comm_world_mod, ONLY : spmd_comm_world
70#include "implicit_f.inc"
71C-----------------------------------------------
72C M e s s a g e P a s s i n g
73C-----------------------------------------------
74#include "spmd.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "com01_c.inc"
79#include "com04_c.inc"
80#include "param_c.inc"
81#include "task_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 INTEGER, INTENT(in) :: IFLAG, ISLEN7, IRLEN7
86 INTEGER, DIMENSION(NPARI,*), INTENT(in) :: IPARI
87
88 TYPE(intbuf_struct_) INTBUF_TAB(*)
89 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93#ifdef MPI
94 INTEGER :: P,LOC_PROC
95 INTEGER :: IBRIC
96 INTEGER :: L,II,IJ,LL,LL0,N,NI
97 INTEGER :: ADD,NB,LEN,LENI,SIZ,IDEB
98 INTEGER :: NIN,NTY,NB_INT18
99 INTEGER :: IERROR,IALLOCS, IALLOCR
100 INTEGER :: MSGTYP,MSGOFF
101 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
102 INTEGER, DIMENSION(NINTER) :: DEBUT,DEBUTE
103 INTEGER, DIMENSION(PARASIZ) :: REQ_SI,REQ_RI
104 INTEGER, DIMENSION(PARASIZ+1) :: ADDS,ADDR
105c parasiz car variable en save
106 DATA msgoff/14141/
107 REAL(kind=8),dimension(:), ALLOCATABLE :: bbufs, bbufr
108 SAVE adds,addr,req_si,req_ri,iallocs,iallocr,bbufs,bbufr
109C-----------------------------------------------
110C S o u r c e L i n e s
111C-----------------------------------------------
112 loc_proc = ispmd + 1
113 nb_int18 = multi_fvm%NUMBER_INT18
114C
115 ! 18 values for the forces (6 per direction x/y/z)
116 ! 1 value for the
117 len = 3*6 + 1
118
119 IF(iflag==1)THEN
120C
121C Partie 1 envoi et preparation buffer reception
122C
123
124C Init
125 DO ii=1,multi_fvm%NUMBER_INT18
126 nin = multi_fvm%INT18_LIST(ii)
127 debut(nin) = 0
128 debute(nin)= 0
129 ENDDO
130 iallocs = len*irlen7
131 ierror=0
132 IF(iallocs>0)
133 + ALLOCATE(bbufs(iallocs+nb_int18*nspmd*2),stat=ierror) ! nbintc*NSPMD*2 majorant place supplementaire bufs
134 IF(ierror/=0) THEN
135 CALL ancmsg(msgid=20,anmode=aninfo)
136 CALL arret(2)
137 END IF
138C
139 iallocr = len*islen7
140
141 ierror=0
142 IF(iallocr>0)
143 + ALLOCATE(bbufr(iallocr+nb_int18*nspmd*2),stat=ierror) ! nbintc*NSPMD*2 majorant place supplementaire bufs
144 IF(ierror/=0) THEN
145 CALL ancmsg(msgid=20,anmode=aninfo)
146 CALL arret(2)
147 END IF
148C
149C Receive
150C
151 l = 0
152 DO p = 1, nspmd
153 add = l+1
154 addr(p) = add
155 siz = 0
156 IF(p/=loc_proc)THEN
157C test en plus pour savoir si com globale necessaire entre les 2 procs
158 DO ii=1,multi_fvm%NUMBER_INT18
159 nin = multi_fvm%INT18_LIST(ii)
160 nb = nsnsi(nin)%P(p)
161 nty = ipari(7,nin)
162 leni = len
163
164 IF(nb>0) THEN
165 l = l + 1 + nb*leni
166 ENDIF
167 ENDDO
168 siz = l+1-add
169 IF(siz>0)THEN
170 msgtyp = msgoff
171 CALL mpi_irecv( bbufr(add),siz,mpi_double_precision,
172 . it_spmd(p),msgtyp,spmd_comm_world,req_ri(p),ierror )
173 ENDIF
174 ENDIF
175 ENDDO
176 addr(nspmd+1) = addr(nspmd)+siz
177C
178C Send
179C
180 l = 0
181 DO p = 1, nspmd
182 add = l+1
183 adds(p) = add
184 siz = 0
185 IF(p/=loc_proc)THEN
186 DO ii=1,multi_fvm%NUMBER_INT18
187 nin = multi_fvm%INT18_LIST(ii)
188 ideb = debut(nin)
189 nb = nsnfi(nin)%P(p)
190 nty = ipari(7,nin)
191 leni = len
192 IF(nb>0) THEN
193 ll = l+1
194 l = l + 1
195 ll0 = ll
196 DO n = 1, nb
197 IF(nsvfi(nin)%P(ideb+n)<0)THEN
198 l = l + 1
199 bbufs(l) = -nsvfi(nin)%P(ideb+n)
200 nsvfi(nin)%P(ideb+n) = -nsvfi(nin)%P(ideb+n)
201 DO ij=1,6
202 bbufs(l+ij) = multi_fvm%R_AFI(nin)%R_FORCE_INT(1,ij,ideb+n)
203 bbufs(l+6+ij) = multi_fvm%R_AFI(nin)%R_FORCE_INT(2,ij,ideb+n)
204 bbufs(l+12+ij) = multi_fvm%R_AFI(nin)%R_FORCE_INT(3,ij,ideb+n)
205 ENDDO
206 DO ij = 1,6
207 multi_fvm%R_AFI(nin)%R_FORCE_INT(1,ij,ideb+n) = 0
208 multi_fvm%R_AFI(nin)%R_FORCE_INT(2,ij,ideb+n) = 0
209 multi_fvm%R_AFI(nin)%R_FORCE_INT(3,ij,ideb+n) = 0
210 ENDDO
211 l = l + 18
212 ENDIF
213 ENDDO
214 bbufs(ll) = (l-ll0)/leni
215 debut(nin) = debut(nin) + nb
216 END IF
217 ENDDO ! ni = 1,ninter
218
219 siz = l+1-add
220 IF(siz>0)THEN
221 msgtyp = msgoff
222 CALL mpi_isend( bbufs(add),siz,mpi_double_precision,it_spmd(p),
223 . msgtyp,spmd_comm_world,req_si(p),ierror )
224 ENDIF ! siz > 0
225 ENDIF ! p /= proc
226 ENDDO ! p=1,nspmd
227 adds(nspmd+1)=adds(nspmd)+siz
228C
229C Attente reception buffer et decompactage
230C
231 ELSEIF(iflag==2)THEN
232C
233C Attente IRECV
234C
235 DO p = 1, nspmd
236 IF(addr(p+1)-addr(p)>0) THEN
237 CALL mpi_wait(req_ri(p),status,ierror)
238 l = addr(p)
239 DO ii=1,multi_fvm%NUMBER_INT18
240 nin = multi_fvm%INT18_LIST(ii)
241 nty =ipari(7,nin)
242 IF(nsnsi(nin)%P(p)>0)THEN
243 nb = nint(bbufr(l))
244 l = l + 1
245 DO ij=1,nb
246 ibric = intbuf_tab(nin)%NSV( nint(bbufr(l)) ) ! id of the phantom node
247 multi_fvm%FORCE_INT_PON(1,1:6,ibric) =
248 . multi_fvm%FORCE_INT_PON(1,1:6,ibric) + bbufr(l+1:l+6)
249 multi_fvm%FORCE_INT_PON(2,1:6,ibric) =
250 . multi_fvm%FORCE_INT_PON(2,1:6,ibric) + bbufr(l+7:l+12)
251 multi_fvm%FORCE_INT_PON(3,1:6,ibric) =
252 . multi_fvm%FORCE_INT_PON(3,1:6,ibric) + bbufr(l+13:l+18)
253 l = l + len
254 ENDDO
255! L = L + NB*LEN
256 END IF ! NSNSI > 0
257 ENDDO ! DO II=1,MULTI_FVM%NUMBER_INT18
258 ENDIF !FLAG adress
259 ENDDO ! NSPMD
260
261C Deallocation R
262 IF(iallocr>0) THEN
263 DEALLOCATE(bbufr)
264 iallocr=0
265 END IF
266C
267C Attente ISEND
268C
269 DO p = 1, nspmd
270 IF(adds(p+1)-adds(p)>0) THEN
271 CALL mpi_wait(req_si(p),status,ierror)
272 ENDIF
273 ENDDO
274C Deallocation S
275 IF(iallocs>0) THEN
276 DEALLOCATE(bbufs)
277 iallocs=0
278 END IF
279 END IF ! IFLAG = 1 or 2
280#endif
281 RETURN
282 END SUBROUTINE spmd_int18_law151_pon
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
message_mod
Definition message_mod.F:1249
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_int18_law151_pon
subroutine spmd_int18_law151_pon(ipari, islen7, irlen7, iflag, intbuf_tab, multi_fvm)
Definition spmd_int18_law151_pon.F:41
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87