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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_i17frots_pon (nskyi17, iskyi17, fskyi17, nrskyi17, irskyi17, frskyi17, nin, lskyi17, noint)

Function/Subroutine Documentation

◆ spmd_i17frots_pon()

subroutine spmd_i17frots_pon ( integer nskyi17,
integer, dimension(*) iskyi17,
fskyi17,
integer nrskyi17,
integer, dimension(*) irskyi17,
frskyi17,
integer nin,
integer lskyi17,
integer noint )

Definition at line 38 of file spmd_i17frots_pon.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE tri7box
45 USE message_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49 USE spmd_comm_world_mod, ONLY : spmd_comm_world
50#include "implicit_f.inc"
51C-----------------------------------------------
52C M e s s a g e P a s s i n g
53C-----------------------------------------------
54#include "spmd.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "task_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NSKYI17, NRSKYI17, NIN, LSKYI17, NOINT,
64 . ISKYI17(*), IRSKYI17(*)
65 my_real
66 . fskyi17(lskyi17,4),
67 . frskyi17(4,*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71#ifdef MPI
72 INTEGER P, L, ADD, LL, NB, LEN, SIZ, LOC_PROC,
73 . IDEB, N, MSGTYP, IERROR, IDEBI, NI, NOD,
74 . IALLOCS, IALLOCR, IES, I, NN, MSGOFF, MSGOFF2,
75 . STATUS(MPI_STATUS_SIZE),
76 . REQ_SI(NSPMD),REQ_S(NSPMD),REQ_R(NSPMD),
77 . ISIZRCV(2,NSPMD),ISIZENV(2,NSPMD),
78 . NSNFITOT(NSPMD),NSNSITOT(NSPMD)
79 DATA msgoff/146/
80 DATA msgoff2/147/
81 LOGICAL ITEST
82 my_real ,DIMENSION(:), ALLOCATABLE :: bbufs, bbufr
83C-----------------------------------------------
84C S o u r c e L i n e s
85C-----------------------------------------------
86 loc_proc = ispmd + 1
87C
88 len = 5
89C
90C Init + ireceive sur taille communication
91C
92 DO p = 1, nspmd
93 isizrcv(1,p)=0
94 isizrcv(2,p)=0
95 isizenv(1,p) = 0
96 isizenv(2,p) = 0
97 nsnfitot(p) = 0
98 nsnsitot(p) = 0
99 IF(p/=loc_proc)THEN
100 siz = nsnsi(nin)%P(p)
101 IF(siz>0)THEN
102 nsnsitot(p) = siz
103 msgtyp = msgoff
104 CALL mpi_irecv(
105 . isizrcv(1,p),2,mpi_integer,it_spmd(p),msgtyp,
106 . spmd_comm_world,req_r(p),ierror )
107 ENDIF
108 ENDIF
109 ENDDO
110C
111C Partie 1 envoi et preparation buffer reception
112C
113
114C
115 IF(nrskyi17>0) THEN
116 CALL sorti20(nrskyi17,irskyi17,frskyi17,4)
117 END IF
118C precomptage du nombre de contacts par processeur+calcul nsnfi total
119 CALL intcontp(
120 + nrskyi17,irskyi17,nsnfi(nin)%P(1),isizenv,nsnfitot,len)
121C
122 iallocs = 0
123 DO p = 1, nspmd
124 IF(p/=loc_proc.AND.nsnfitot(p)>0) THEN
125 msgtyp = msgoff
126 CALL mpi_isend(
127 . isizenv(1,p),2,mpi_integer,it_spmd(p),msgtyp,
128 . spmd_comm_world,req_s(p),ierror )
129 iallocs = iallocs + isizenv(1,p)
130 ENDIF
131 END DO
132 ierror=0
133 IF(iallocs>0)
134 + ALLOCATE(bbufs(iallocs+nspmd),stat=ierror)
135 IF(ierror/=0) THEN
136 CALL ancmsg(msgid=20,anmode=aninfo)
137 CALL arret(2)
138 END IF
139C
140C Send
141C
142 ideb = 0
143 idebi = 1
144 l = 0
145 DO p = 1, nspmd
146 IF(p/=loc_proc.AND.isizenv(1,p)>0)THEN
147 add = l+1
148 nb = nsnfi(nin)%P(p)
149 IF(nb>0) THEN
150 ll = l+1
151 l = l + 1
152 DO n = 1, nb
153 IF(nsvfi(nin)%P(ideb+n)<0)THEN
154C facette element generant une force
155 ies = -nsvfi(nin)%P(ideb+n)
156 IF(idebi<=nrskyi17) THEN
157 itest = irskyi17(idebi)==ideb+n
158 ELSE
159 itest = .false.
160 ENDIF
161 DO WHILE(itest)
162 bbufs(l+1) = ies
163 bbufs(l+2) = frskyi17(1,idebi)
164 bbufs(l+3) = frskyi17(2,idebi)
165 bbufs(l+4) = frskyi17(3,idebi)
166 bbufs(l+5) = frskyi17(4,idebi)
167 idebi = idebi + 1
168 l = l + len
169 IF(idebi<=nrskyi17) THEN
170 itest = irskyi17(idebi)==ideb+n
171 ELSE
172 itest = .false.
173 ENDIF
174 ENDDO
175 ENDIF
176 ENDDO
177 bbufs(ll) = (l-ll)/len
178 ideb = ideb + nb
179 END IF
180 siz = l+1-add
181 msgtyp = msgoff2
182 CALL mpi_isend(
183 . bbufs(add),siz,real ,it_spmd(p),msgtyp,
184 . spmd_comm_world,req_si(p),ierror )
185 ELSEIF(p/=loc_proc)THEN
186 ideb = ideb + nsnfi(nin)%P(p)
187 END IF
188 END DO
189C
190C Receive 1er message : taille communication
191C
192 iallocr = 0
193 DO p = 1, nspmd
194 IF(nsnsitot(p)>0)THEN
195 CALL mpi_wait(req_r(p),status,ierror)
196 iallocr = max(iallocr,isizrcv(1,p)) ! pour comm bloquantes
197 END IF
198 END DO
199C
200 ierror=0
201 IF(iallocr>0)
202 . ALLOCATE(bbufr(iallocr+1),stat=ierror)
203 IF(ierror/=0) THEN
204 CALL ancmsg(msgid=20,anmode=aninfo)
205 CALL arret(2)
206 ENDIF
207C
208C Reception buffer et decompactage
209C
210 DO p = 1, nspmd
211 IF(isizrcv(1,p)>0) THEN
212 msgtyp = msgoff2
213 l = 1
214 CALL mpi_recv(
215 . bbufr(l),isizrcv(1,p)+1,real ,it_spmd(p),msgtyp,
216 . spmd_comm_world ,status,ierror )
217C
218 IF(nsnsi(nin)%P(p)>0)THEN
219 nb = nint(bbufr(l))
220 l = l + 1
221C
222 IF (nskyi17+nb > lskyi17) THEN
223 CALL ancmsg(msgid=25,anmode=aninfo_blind,
224 . i1=noint)
225 CALL arret(2)
226 ENDIF
227C
228 DO i = 1, nb
229 nn = nint(bbufr(5*(i-1)+l))
230 nskyi17 = nskyi17+1
231 iskyi17(nskyi17)=nn
232 fskyi17(nskyi17,1)=bbufr(5*(i-1)+l+1)
233 fskyi17(nskyi17,2)=bbufr(5*(i-1)+l+2)
234 fskyi17(nskyi17,3)=bbufr(5*(i-1)+l+3)
235 fskyi17(nskyi17,4)=bbufr(5*(i-1)+l+4)
236 END DO
237 l = l + nb*len
238 END IF
239 ENDIF
240 ENDDO
241 IF(iallocr>0) DEALLOCATE(bbufr)
242C
243C Attente ISEND
244C
245 DO p = 1, nspmd
246 IF(p/=loc_proc)THEN
247 IF(nsnfitot(p)>0) THEN
248 CALL mpi_wait(req_s(p),status,ierror)
249 END IF
250 IF(isizenv(1,p)>0)THEN
251 CALL mpi_wait(req_si(p),status,ierror)
252 END IF
253 END IF
254 END DO
255 IF(iallocs>0) DEALLOCATE(bbufs)
256C
257#endif
258 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
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
intcontp
subroutine intcontp(n, isky, nsnfi, isizenv, nsnfitot, len)
Definition spmd_i7tool.F:6233
sorti20
subroutine sorti20(n, isky, fskyi, nfskyi)
Definition spmd_i7tool.F:6078
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