OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i7itied_cand.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_i7itied_cand (flag, nbintc, ipari, intlist, intbuf_tab)

Function/Subroutine Documentation

◆ spmd_i7itied_cand()

subroutine spmd_i7itied_cand ( integer flag,
integer nbintc,
integer, dimension(npari,*) ipari,
integer, dimension(*) intlist,
type(intbuf_struct_), dimension(*) intbuf_tab )

Definition at line 34 of file spmd_i7itied_cand.F.

35
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE tri7box
40 USE message_mod
41 USE intbufdef_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45 USE spmd_comm_world_mod, ONLY : spmd_comm_world
46#include "implicit_f.inc"
47C-----------------------------------------------
48C M e s s a g e P a s s i n g
49C-----------------------------------------------
50#include "spmd.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "param_c.inc"
55#include "com04_c.inc"
56#include "task_c.inc"
57#include "com01_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER :: NBINTC,FLAG
62 INTEGER IPARI(NPARI,*),INTLIST(*)
63C
64 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
65! -------------------------------
66! NBINTC : integer , number of interface (different from TYPE2)
67! FLAG : integer , FLAG=1 --> sent part ; FLAG=2 --> received part
68! IPARI : integer , dimension = (NPARI,*) , property interface array
69! INTLIST : integer, dimension = * , index of interface /= from TYPE2
70! INTBUF_TAB : type(INTBUF_STRUCT_), dimension = number of interface, interface structure
71! -------------------------------
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75#ifdef MPI
76 INTEGER :: STATUS(MPI_STATUS_SIZE),REQ_S(PARASIZ),REQ_R(PARASIZ)
77 INTEGER :: P,LENSD,LENRV,IADS(PARASIZ+1),IADR(PARASIZ+1),IERROR,
78 * SIZ,LOC_PROC,MSGTYP,IDEB(NINTER),PROC,MSGOFF
79 INTEGER :: ITIED
80
81 INTEGER :: I,J,L,NB,NL,NN,K,N,NOD,LEN,ND,NIN,NTY,
82 * NSN,SN,NBI,NSI,
83 * I_STOK,IT,LEN_NSNSI,MS,NSNR,
84 * NI,NII,LL,ILEN,RLEN,LI,NUMERO,P2
85 INTEGER, DIMENSION(NINTER) :: LLL
86 INTEGER, DIMENSION(:), ALLOCATABLE :: BBUFS, BBUFR
87 INTEGER:: LEN_CANDF
88
89 DATA msgoff/9000/
90
91 SAVE iads,iadr,bbufs,bbufr,req_s,
92 * req_r,ilen,rlen,len,lensd,lenrv
93! ----------------------------------------------
94! FI proc send to SI proc the ITIED+CAND_F/=0
95! nodes
96! with ITIED==2, a node is linked to an interface unless
97! its CAND_F force is 0. CAND_F is a local to a processor
98! --> need to exchange CAND_F to the local processor if
99! a node is remote on a processor
100!
101!
102! sent buffer : (for the 3th proc)
103! proc : 1 * 2 * 4 *
104! <-----------> <-------> <--------->
105! | | | | * | | | * | | |* ...
106! inter : 1 3 9 1 ...
107!
108! proc : 1 * 2 * 4 *
109! <-----------> * <-------> * <--------->
110! 1 SUM(NSNFI(1)) SUM(NSNFI(1))+SUM(NSNFI(2)) ...
111!
112! proc : 1
113! <------------------------------------------- ...
114! | | |
115! inter : 1 | 3 | ...
116! 1 NSNFI(1)%P(1) NSNFI(1)%P(1)+NSNFI(1)%P(3)
117!
118!
119! length for the nth proc = SUM( NSNFI%P(n) ) for all NINTER interfaces
120! total length the nth proc = SUM( NSNFI%P( 1-->NSPMD ) ) for all NINTER interfaces
121!
122!
123! to initialize the buffer, the I_STOCK candidate nodes are scanned
124! if a candidate node is a remote node (--> CAND_N > NSN) AND its CAND_F value
125! is non-zero, then this node must be transmitted to the SI proc
126! for a remote node, CAND_N = NSN + SUM( NSNFI(NIN)%P(p)) + ii
127! ii is the local index of the node
128! --> so ii = CAND_N - NSN - SUM( NSNFI(NIN)%P(p)) is sent to the local proc SI
129! if CAND_F /= 0
130!
131!
132!
133!
134! received buffer : (for the 3th proc)
135! proc : 1 * 2 * 4 *
136! <-----------> <-------> <--------->
137! | | | | * | | | * | | |* ...
138! inter : 8 10 11 1 ...
139! length for the nth proc = SUM( NSNSI%P(n) ) for all NINTER interfaces
140! total length the nth proc = SUM( NSNSI%P( 1-->NSPMD ) ) for all NINTER interfaces
141!
142!
143
144 IF(nspmd==1) RETURN
145! ----------------------------------------------
146
147! sent part
148 IF(flag==1) THEN
149 ! -----------------------------
150 ! get the number of sent/received nodes
151 loc_proc = ispmd+1
152 iads(1:nspmd+1) = 0
153 iadr(1:nspmd+1) = 0
154 lensd = 0
155 lenrv = 0
156 DO p=1,nspmd
157 iadr(p)=lenrv+1
158 DO ni=1,nbintc
159 nin = intlist(ni)
160 nty = ipari(7,nin)
161 itied = ipari(85,nin)
162 IF(nty==10 .OR.(nty==7.AND.itied/=0))THEN
163 lensd = lensd + nsnfi(nin)%P(p)
164 lenrv = lenrv + nsnsi(nin)%P(p)
165 ENDIF
166 ENDDO
167 ENDDO
168
169 iadr(nspmd+1)=lenrv+1
170 ! allocate the sent/received buffer
171 IF(lensd>0) THEN
172 ALLOCATE(bbufs(lensd))
173 bbufs(1:lensd) = 0
174 ENDIF
175 IF(lenrv>0) THEN
176 ALLOCATE(bbufr(lenrv))
177 bbufr(1:lenrv) = 0
178 ENDIF
179
180 ! received comm
181 DO p=1, nspmd
182 siz=iadr(p+1)-iadr(p)
183 IF (siz > 0) THEN
184 msgtyp = msgoff
185 CALL mpi_irecv( bbufr(iadr(p)),siz,mpi_integer,it_spmd(p),msgtyp,
186 . spmd_comm_world,req_r(p),ierror )
187
188 ENDIF
189 ENDDO
190
191 ! fill the sent buffer
192 l=1
193 ideb(1:ninter) = 0
194 DO p=1, nspmd
195 iads(p)=l
196 IF (p/= loc_proc) THEN
197 DO ni=1,nbintc
198 nin = intlist(ni)
199 nty =ipari(7,nin)
200 itied = ipari(85,nin)
201 nsn = ipari(5,nin)
202 len_candf =8
203 IF(nty==10) len_candf=6
204 IF(nty==10 .OR. (nty==7.AND.itied/=0)) THEN
205 ! compute SUM( NSNFI(NIN)%P(1-->P-1))
206 numero=0
207 DO p2=1,p-1
208 numero=numero+nsnfi(nin)%P(p2)
209 ENDDO
210 nb = nsnfi(nin)%P(p)
211 ll = 0
212 DO nn=1,intbuf_tab(nin)%I_STOK(1)
213 nii = intbuf_tab(nin)%CAND_N(nn)
214 ! check if the remote node is on P processor
215 ! --> SUM( NSNFI(NIN)%P(1-->P-1)) < NII-NSN < SUM( NSNFI(NIN)%P(1-->P))
216 IF( nii>nsn
217 . .AND. ((nii-nsn)>numero)
218 . .AND. ((nii-nsn)<=numero+nsnfi(nin)%P(p)) ) THEN
219 ! remote node
220 IF(intbuf_tab(nin)%CAND_F(len_candf*(nn-1)+1)/=zero) THEN
221 bbufs(l-1+nii-nsn-numero)= 1
222 ll = ll + 1
223 ENDIF
224 ENDIF
225 ENDDO
226 l = l + nb
227 ENDIF
228 ENDDO ! DO NI=1,NBINTC
229 siz = l-iads(p)
230 IF(siz>0)THEN
231 msgtyp = msgoff
232
233 CALL mpi_isend(bbufs(iads(p)),siz,mpi_integer,it_spmd(p),msgtyp,
234 . spmd_comm_world,req_s(p),ierror)
235 ENDIF
236 ENDIF ! ENDIF P/= LOC_PROC
237 ENDDO ! DO P=1, NSPMD
238 ! end of sent part
239 ! -----------------------------
240 ELSEIF(flag==2) THEN
241 ! -----------------------------
242 ! receveid part
243
244 l=0
245 ideb(1:ninter) = 0
246
247 lll(1:ninter) = 0
248 DO ni=1,nbintc
249 nin = intlist(ni)
250 nty =ipari(7,nin)
251 itied = ipari(85,nin)
252 nsn = ipari(5,nin)
253 IF(nty==10 .OR. (nty==7.AND.itied/=0)) THEN
254 candf_si(nin)%P(1:nsn)=0
255 ENDIF
256 ENDDO
257
258 DO p=1, nspmd
259 l=0
260 siz=iadr(p+1)-iadr(p)
261 IF (siz > 0) THEN
262 msgtyp = msgoff
263 CALL mpi_wait(req_r(p),status,ierror)
264 DO ni=1,nbintc
265 nin = intlist(ni)
266 nty =ipari(7,nin)
267 itied = ipari(85,nin)
268 nsn = ipari(5,nin)
269 ! compute SUM( NSNFI(NIN)%P(1-->P-1))
270 numero=0
271 DO p2=1,p-1
272 numero=numero+nsnsi(nin)%P(p2)
273 ENDDO
274 IF(nty==10 .OR. (nty==7.AND.itied/=0)) THEN
275 nb = nsnsi(nin)%P(p)
276 IF (nb > 0)THEN
277 DO k=1,nb
278 ll = bbufr(iadr(p)+l)
279 IF(ll/=0) THEN
280 sn=nsvsi(nin)%P(k+ideb(nin))
281 candf_si(nin)%P(sn) = 1
282 ENDIF
283 l = l + 1
284 ENDDO
285 ENDIF
286 ideb(nin)=ideb(nin)+nb
287 ENDIF ! NTY==7.AND.ITIED/=0
288 ENDDO ! DO NI=1,NBINTC
289 ENDIF ! size > 0
290 ENDDO ! DO P=1, NSPMD
291
292 DO p = 1, nspmd
293 IF (p==nspmd)THEN
294 siz=lensd-iads(p)
295 ELSE
296 siz=iads(p+1)-iads(p)
297 ENDIF
298 IF(siz>0) THEN
299 CALL mpi_wait(req_s(p),status,ierror)
300 ENDIF
301 ENDDO
302
303 IF (ALLOCATED(bbufs)) DEALLOCATE(bbufs)
304 IF (ALLOCATED(bbufr)) DEALLOCATE(bbufr)
305
306 ! end of receveid part
307 ! -----------------------------
308 ENDIF
309
310! ----------------------------------------------
311
312
313#endif
314 RETURN
315
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::candf_si
type(int_pointer), dimension(:), allocatable candf_si
Definition tri7box.F:560
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440