OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_da20.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_exch_da20 ../engine/source/mpi/interfaces/spmd_exch_da20.F
26!||--- called by ------------------------------------------------------
27!|| resol ../engine/source/engine/resol.F
28!||--- calls -----------------------------------------------------
29!|| adddp ../engine/source/mpi/interfaces/spmd_i7tool.F
30!|| getdpdaanc ../engine/source/mpi/interfaces/spmd_i7tool.f
31!|| putdpdaanc ../engine/source/mpi/interfaces/spmd_i7tool.F
32!||--- uses -----------------------------------------------------
33!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
34!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
35!||====================================================================
36 SUBROUTINE spmd_exch_da20(
37 1 INTBUF_TAB,IPARI,IAD_ELEM,FR_ELEM,
38 2 LEN20,NBINT20,LENR ,INTLIST ,NBINTC )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE intbufdef_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46 USE spmd_comm_world_mod, ONLY : spmd_comm_world
47#include "implicit_f.inc"
48C-----------------------------------------------------------------
49C M e s s a g e P a s s i n g
50C-----------------------------------------------
51#include "spmd.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "scr05_c.inc"
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "task_c.inc"
59#include "param_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IAD_ELEM(2,*),FR_ELEM(*), IPARI(NPARI,*),
64 . INTLIST(*),
65 . nbintc, len20, nbint20, lenr
66
67 TYPE(intbuf_struct_) INTBUF_TAB(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71#ifdef MPI
72 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,INDEX, N, MSGOFF,
73 . SIZ,J,K,L,NB_NOD,NBIRECV, II, JJ, NI,INC,
74 . nin, nln, ll,il,ig,
75 . iad_recv(nspmd+1),debut(nspmd),
76 . status(mpi_status_size),rstatus(mpi_status_size,nspmd),
77 . req_r(nspmd),req_s(nspmd),irindex(nspmd),
78 . itagx(numnod),isign,p
79 double precision
80 . rbuf(nbint20*(len20*lenr+nspmd)),
81 . sbuf(nbint20*(len20*lenr+nspmd)),daanc6l(3,6)
82 DATA msgoff/172/
83C-----------------------------------------------
84C S o u r c e L i n e s
85C-----------------------------------------------
86C LEN20 = 1 + 18 + 2 ! (1 : longueur ; 18 : daanc6 et 2 : alphak)
87C SIZE = LEN20*NBINT20
88C
89 loc_proc = ispmd + 1
90C
91 nbirecv = 0
92 l = 1
93 iad_recv(1) = 1
94 DO i = 1, nspmd
95 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
96 siz = nbint20*(len20*(iad_elem(1,i+1)-iad_elem(1,i))+1)
97 msgtyp = msgoff
98 nbirecv = nbirecv + 1
99 irindex(nbirecv) = i
100 CALL mpi_irecv(
101 s rbuf(l),siz,mpi_double_precision,it_spmd(i),msgtyp,
102 g spmd_comm_world,req_r(nbirecv),ierror)
103 l = l + siz
104 ENDIF
105 iad_recv(i+1) = l
106 debut(i) = iad_recv(i)
107 ENDDO
108C
109C Pre Traitement interfaces
110C
111 DO ni = 1, nbintc
112 nin = intlist(ni)
113 IF(ipari(7,nin)==20)THEN
114 nln=ipari(35,nin)
115C
116 DO i = 1, numnod
117 itagx(i) = 0
118 ENDDO
119#include "vectorize.inc"
120 DO il = 1, nln
121 ig = intbuf_tab(nin)%NLG(il)
122 itagx(ig) = il
123 END DO
124C
125 DO i = 1, nspmd
126 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
127 ll = debut(i)
128 sbuf(ll)=0
129 l = ll+1
130 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
131 nod = fr_elem(j)
132 IF(itagx(nod)/=0)THEN
133 ii = itagx(nod)
134 sbuf(l) = j+1-iad_elem(1,i)
135C ALPHAK(2)
136 sbuf(l+1) =intbuf_tab(nin)%ALPHAK((ii-1)*3+2)
137C ALPHAK(3)
138 sbuf(l+2) =intbuf_tab(nin)%ALPHAK((ii-1)*3+3)
139 CALL putdpdaanc(
140 . intbuf_tab(nin)%DAANC6(1+(ii-1)*3*6*2),sbuf(l+3),iresp,inc)
141C L = L + 18 car variable en double precision
142 sbuf(ll) = sbuf(ll)+1
143 l = l + len20
144 END IF
145 ENDDO
146 debut(i) = l
147 ENDIF
148 ENDDO
149 ENDIF
150 ENDDO
151C
152C echange messages
153C
154 DO ii = 1, nbirecv
155 i = irindex(ii)
156 l = iad_recv(i)
157 siz = debut(i)-l
158 msgtyp = msgoff
159 CALL mpi_isend(
160 s sbuf(l),siz,mpi_double_precision,it_spmd(i),msgtyp,
161 g spmd_comm_world,req_s(i),ierror)
162 ENDDO
163C
164C decompactage
165C
166 CALL mpi_waitall(nbirecv,req_r,rstatus,ierror)
167 DO ni = 1, nbintc
168 nin = intlist(ni)
169 IF(ipari(7,nin)==20)THEN
170 nln=ipari(35,nin)
171C
172c DO II = 1, NUMNOD
173 itagx(1:numnod) = 0
174c ENDDO
175#include "vectorize.inc"
176 DO il = 1, nln
177 ig = intbuf_tab(nin)%NLG(il)
178 itagx(ig) = il
179 END DO
180C
181 DO i=1,nbirecv
182
183 p = irindex(i)
184 l = iad_recv(p)
185
186 nb_nod = nint(rbuf(l))
187 l = l + 1
188#include "vectorize.inc"
189 DO n = 1, nb_nod
190 j = nint(rbuf(l))
191 nod = fr_elem(iad_elem(1,p)+j-1)
192 ii = itagx(nod)
193 if (ii>0)THEN
194C ALPHAK(2)
195 isign = 1
196 IF(intbuf_tab(nin)%ALPHAK((ii-1)*3+2) < zero .OR. rbuf(l+1) <zero)
197 * isign = -1
198 intbuf_tab(nin)%ALPHAK((ii-1)*3+2)=isign*
199 . min(abs(intbuf_tab(nin)%ALPHAK((ii-1)*3+2)),
200 . abs(rbuf(l+1)))
201C ALPHAK(3)
202 intbuf_tab(nin)%ALPHAK((ii-1)*3+3)=min(intbuf_tab(nin)%ALPHAK((ii-1)*3+3),
203 . rbuf(l+2))
204 CALL getdpdaanc(daanc6l,rbuf(l+3),iresp,inc)
205C L = L + 18 car variable en double precision
206 CALL adddp(intbuf_tab(nin)%DAANC6(1+(ii-1)*3*6*2),daanc6l,18)
207 ENDIF
208 l = l + len20
209 END DO
210C Repositionne IAD_RECV pour l'interface suivante
211 iad_recv(p)=l
212 END DO
213 END IF
214 END DO
215C
216C wait terminaison isend
217C
218 DO i = 1, nspmd
219 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
220 . CALL mpi_wait(req_s(i),status,ierror)
221 ENDDO
222C
223#endif
224 RETURN
225 END
min
#define min(a, b)
Definition macros.h:20
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_waitall
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
Definition mpi.f:536
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
spmd_exch_da20
subroutine spmd_exch_da20(intbuf_tab, ipari, iad_elem, fr_elem, len20, nbint20, lenr, intlist, nbintc)
Definition spmd_exch_da20.F:39
putdpdaanc
subroutine putdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7399
getdpdaanc
subroutine getdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7361
adddp
subroutine adddp(daanc6, daanc6l, len)
Definition spmd_i7tool.F:7116