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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_exch_efric (ipari, intlist, nbintc, islen7, irlen7, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, intbuf_tab, h3d_data)

Function/Subroutine Documentation

◆ spmd_exch_efric()

subroutine spmd_exch_efric ( integer, dimension(npari,ninter), intent(in) ipari,
integer, dimension(nbintc), intent(in) intlist,
integer, intent(in) nbintc,
integer, intent(in) islen7,
integer, intent(in) irlen7,
integer, intent(in) irlen7t,
integer, intent(in) islen7t,
integer, intent(in) irlen20,
integer, intent(in) islen20,
integer, intent(in) irlen20t,
integer, intent(in) islen20t,
type(intbuf_struct_), dimension(ninter), intent(in) intbuf_tab,
type(h3d_database), intent(in) h3d_data )

Definition at line 39 of file spmd_exch_efric.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE tri7box
47 USE tri25ebox
48 USE message_mod
49 USE intbufdef_mod
50 USE outputs_mod
51 USE h3d_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55 USE spmd_comm_world_mod, ONLY : spmd_comm_world
56#include "implicit_f.inc"
57C-----------------------------------------------
58C M e s s a g e P a s s i n g
59C-----------------------------------------------
60#include "spmd.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "param_c.inc"
67#include "task_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER , INTENT(IN) ::
72 . NBINTC,ISLEN7, IRLEN7,IRLEN7T, ISLEN7T,
73 . IRLEN20, ISLEN20, IRLEN20T, ISLEN20T,
74 . IPARI(NPARI,NINTER), INTLIST(NBINTC)
75 TYPE(INTBUF_STRUCT_),INTENT(IN) :: INTBUF_TAB(NINTER)
76 TYPE(H3D_DATABASE), INTENT(IN) :: H3D_DATA
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80#ifdef MPI
81 INTEGER P, L, ADD, LL, NB, LEN, SIZ, KFI, LOC_PROC, MULTIMP, II,
82 . NIN, IDEB, N, MSGTYP, IERROR, NI, NOD, I,
83 . NTY, IALLOCS, IALLOCR, MSGOFF,INTERFRIC,
84 . STATUS(MPI_STATUS_SIZE),DEBUT(NINTER),
85 . ADDS(NSPMD+1), ADDR(NSPMD+1),
86 . REQ_SI(NSPMD),REQ_RI(NSPMD),INTCOMM(NBINTC)
87 DATA msgoff/190/
88 LOGICAL ITEST
89 my_real ,DIMENSION(:), ALLOCATABLE :: bbufs, bbufr
90 LOGICAL :: IS_EFRIC_COM_NEEDED
91C-----------------------------------------------
92C S o u r c e L i n e s
93C-----------------------------------------------
94 loc_proc = ispmd + 1
95C
96 len = 3
97C
98C Part 1 : prepare send/reception buffers and if comm is needed
99C
100 is_efric_com_needed = .false.
101 intcomm(1:nbintc) = 0
102 DO ii = 1, nbintc
103 nin = intlist(ii)
104 nty = ipari(7,nin)
105 IF(nty==7.OR.nty==24.OR.nty==25) THEN
106 interfric = h3d_data%N_CSE_FRIC_INTER(nin)
107 IF(h3d_data%N_SCAL_CSE_FRIC > 0) THEN
108 intcomm(ii) = 1
109 is_efric_com_needed = .true.
110 ELSEIF(interfric > 0)THEN
111 intcomm(ii) = 1
112 is_efric_com_needed = .true.
113 ENDIF
114 ENDIF
115 debut(nin) = 0
116 ENDDO
117
118 IF(is_efric_com_needed) THEN
119
120 iallocs = len*(irlen7+irlen25) + len*(irlen7t+irlen25t)
121 ierror=0
122 IF(iallocs>0)
123 + ALLOCATE(bbufs(iallocs+nbintc*nspmd),stat=ierror)
124 IF(ierror/=0) THEN
125 CALL ancmsg(msgid=20,anmode=aninfo)
126 CALL arret(2)
127 END IF
128 iallocr = len*(islen7+islen25) + len*(islen7t+islen25t)
129 ierror=0
130 IF(iallocr>0)
131 + ALLOCATE(bbufr(iallocr+nbintc*nspmd),stat=ierror)
132 IF(ierror/=0) THEN
133 CALL ancmsg(msgid=20,anmode=aninfo)
134 CALL arret(2)
135 END IF
136C
137C Receive
138C
139 l = 0
140 DO p = 1, nspmd
141 add = l+1
142 addr(p) = add
143 siz = 0
144 IF(p/=loc_proc)THEN
145 DO ii = 1, nbintc
146 nin = intlist(ii)
147 nb = nsnsi(nin)%P(p)
148 IF(intcomm(ii) > 0 ) THEN
149 IF(nb>0) THEN
150 l = l + 1 + nb*len
151 ENDIF
152 ENDIF
153 ENDDO
154 siz = l+1-add
155 IF(siz>0)THEN
156 msgtyp = msgoff
157 CALL mpi_irecv(
158 . bbufr(add),siz,real ,it_spmd(p),msgtyp,
159 . spmd_comm_world,req_ri(p),ierror )
160 ENDIF
161 ENDIF
162 ENDDO
163 addr(nspmd+1) = addr(nspmd)+siz
164C
165C Send
166C
167 l = 0
168 DO p = 1, nspmd
169 add = l+1
170 adds(p) = add
171 siz = 0
172 IF(p/=loc_proc)THEN
173 DO ii = 1, nbintc
174 nin = intlist(ii)
175 ideb = debut(nin)
176 nb = nsnfi(nin)%P(p)
177 interfric = h3d_data%N_CSE_FRIC_INTER(nin)
178 IF(intcomm(ii) > 0) THEN
179 IF(nb>0) THEN
180 ll = l+1
181 l = l + 1
182 DO n = 1, nb
183 bbufs(l+1) = abs(nsvfi(nin)%P(ideb+n))
184 IF(interfric>0) THEN
185 bbufs(l+2) = efricfi(nin)%P(ideb+n)
186 efricfi(nin)%P(ideb+n) = zero
187 ELSE
188 bbufs(l+2) = zero
189 ENDIF
190 IF(h3d_data%N_SCAL_CSE_FRIC>0) THEN
191 bbufs(l+3) = efricgfi(nin)%P(ideb+n)
192 efricgfi(nin)%P(ideb+n) = zero
193 ELSE
194 bbufs(l+3) = zero
195 ENDIF
196 l = l + len
197 ENDDO
198 bbufs(ll) = (l-ll)/len
199 debut(nin) = debut(nin) + nb
200 END IF
201 END IF
202 ENDDO
203 siz = l+1-add
204 IF(siz>0)THEN
205 msgtyp = msgoff
206 CALL mpi_isend(
207 . bbufs(add),siz,real ,it_spmd(p),msgtyp,
208 . spmd_comm_world,req_si(p),ierror )
209 ENDIF
210 ENDIF
211 ENDDO
212 adds(nspmd+1)=adds(nspmd)+siz
213
214C
215C Waiting reception
216C
217 DO p = 1, nspmd
218 IF(addr(p+1)-addr(p)>0) THEN
219 CALL mpi_wait(req_ri(p),status,ierror)
220 l = addr(p)
221 DO ii = 1, nbintc
222 nin = intlist(ii)
223 IF(nsnsi(nin)%P(p)>0)THEN
224 interfric = h3d_data%N_CSE_FRIC_INTER(nin)
225 IF(intcomm(ii) > 0) THEN
226 nb = nint(bbufr(l))
227 l = l + 1
228 DO i = 1, nb
229 n = nint(bbufr(l+len*(i-1)))
230 nod = intbuf_tab(nin)%NSV(n)
231 IF(nod<=numnod)THEN
232 IF(interfric>0) efric(interfric,nod)= efric(interfric,nod)+ bbufr(l+len*(i-1)+1)
233 IF(h3d_data%N_SCAL_CSE_FRIC>0) efricg(nod)= efricg(nod)+ bbufr(l+len*(i-1)+2)
234 ENDIF
235 ENDDO
236 l = l + nb*len
237 END IF
238 ENDIF
239 ENDDO
240 ENDIF
241 ENDDO
242C Deallocation R
243 IF(iallocr>0) THEN
244 DEALLOCATE(bbufr)
245 END IF
246C
247C Attente ISEND
248C
249 DO p = 1, nspmd
250 IF(adds(p+1)-adds(p)>0) THEN
251 CALL mpi_wait(req_si(p),status,ierror)
252 ENDIF
253 ENDDO
254C Deallocation S
255 IF(iallocs>0) THEN
256 DEALLOCATE(bbufs)
257 END IF
258C
259 ENDIF ! IS_EFRIC_COM_NEEDED
260C
261#endif
262 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
outputs_mod
Definition outputs_mod.F:59
tri25ebox::irlen25
integer irlen25
Definition tri25ebox.F:76
tri25ebox::irlen25t
integer irlen25t
Definition tri25ebox.F:78
tri25ebox::islen25t
integer islen25t
Definition tri25ebox.F:78
tri25ebox::islen25
integer islen25
Definition tri25ebox.F:76
tri7box::efricgfi
type(real_pointer), dimension(:), allocatable efricgfi
Definition tri7box.F:511
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::efricfi
type(real_pointer), dimension(:), allocatable efricfi
Definition tri7box.F:511
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
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