OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i18kine_com_acc.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_i18kine_com_acc (ipari, intbuf_tab, mtf, a, itab, tagpene)

Function/Subroutine Documentation

◆ spmd_i18kine_com_acc()

subroutine spmd_i18kine_com_acc ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
mtf,
a,
integer, dimension(*) itab,
integer, dimension(*) tagpene )

Definition at line 36 of file spmd_i18kine_com_acc.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE tri7box
42 USE message_mod
43 USE intbufdef_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47 USE spmd_comm_world_mod, ONLY : spmd_comm_world
48#include "implicit_f.inc"
49C-----------------------------------------------
50C M e s s a g e P a s s i n g
51C-----------------------------------------------
52#include "spmd.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "param_c.inc"
57#include "com04_c.inc"
58#include "task_c.inc"
59#include "com01_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IPARI(NPARI,*),ITAB(*),TAGPENE(*)
64C
65 my_real
66 . mtf(14,*),a(3,*)
67
68 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72#ifdef MPI
73 INTEGER STATUS(MPI_STATUS_SIZE),
74 * REQ_SI(NSPMD),REQ_RI(NSPMD)
75 INTEGER P,LENSD,LENRV,IADS(NSPMD+1),IADR(NSPMD+1),IERROR,
76 * SIZ,LOC_PROC,MSGTYP,MSGOFF,IDEB(NINTER)
77 INTEGER NIN,NTY,INACTI
78 INTEGER J,L,NB,NN,K,N,NOD,MODE,LEN,ALEN,ND
79 my_real ,
80 * DIMENSION(:), ALLOCATABLE :: bbufs, bbufr
81 DATA msgoff/150/
82C-----------------------------------------------
83C Sur la type 18KINE, il faut communiquer les accelerations des nds seconds
84
85 loc_proc = ispmd+1
86 iads = 0
87 iadr = 0
88 lensd = 0
89 lenrv = 0
90
91 alen=8
92C Comptage des tailles de buffer Receeption et envoi
93 DO p=1,nspmd
94 iadr(p)=lenrv+1
95 DO nin=1,ninter
96 nty=ipari(7,nin)
97 inacti =ipari(22,nin)
98 IF((nty==7.and.ipari(34,nin)==-2.and.inacti==7).OR.
99 . (nty==22.and.ipari(34,nin)==-2.and.inacti==7)) THEN
100 lensd = lensd + nsnsi(nin)%P(p)*alen
101 lenrv = lenrv + nsnfi(nin)%P(p)*alen
102 ENDIF
103 ENDDO
104 ENDDO
105 iadr(nspmd+1)=lenrv+1
106
107 IF(lensd>0)THEN
108 ALLOCATE(bbufs(lensd),stat=ierror)
109 IF(ierror/=0) THEN
110 CALL ancmsg(msgid=20,anmode=aninfo)
111 CALL arret(2)
112 ENDIF
113 ENDIF
114
115C Preparation du recieve
116 IF(lenrv>0)THEN
117 ALLOCATE(bbufr(lenrv),stat=ierror)
118 IF(ierror/=0) THEN
119 CALL ancmsg(msgid=20,anmode=aninfo)
120 CALL arret(2)
121 ENDIF
122 ENDIF
123
124C Send
125 l=1
126 ideb = 0
127 DO p=1, nspmd
128 iads(p)=l
129 IF (p/= loc_proc) THEN
130 DO nin=1,ninter
131 nty =ipari(7,nin)
132 inacti =ipari(22,nin)
133 IF((nty==7.and.ipari(34,nin)==-2.and.inacti==7).OR.
134 . (nty==22.and.ipari(34,nin)==-2.and.inacti==7))THEN
135 nb = nsnsi(nin)%P(p)
136C Preparation du send
137 DO nn=1,nb
138 nd = nsvsi(nin)%P(ideb(nin)+nn)
139 nod=intbuf_tab(nin)%NSV(nd)
140 bbufs(l )=a(1,nod)
141 bbufs(l+1)=a(2,nod)
142 bbufs(l+2)=a(3,nod)
143 bbufs(l+3)=mtf(10,nod)
144 IF(tagpene(nod) == p)THEN
145 bbufs(l+4) = mtf(11,nod)
146 ELSE
147 bbufs(l+4) = -abs(mtf(11,nod)*(1-em6))
148 ENDIF
149c BBUFS(L+4)=MTF(11,NOD)
150 bbufs(l+5)=mtf(12,nod)
151 bbufs(l+6)=mtf(13,nod)
152 bbufs(l+7)=mtf(14,nod)
153 l=l+8
154 ENDDO
155 ENDIF
156 ideb(nin)=ideb(nin)+nb
157 ENDDO
158
159 siz = l-iads(p)
160 IF(siz>0)THEN
161 msgtyp = msgoff
162C Send
163 CALL mpi_isend(
164 . bbufs(iads(p)),siz,real ,it_spmd(p),msgtyp,
165 . spmd_comm_world,req_si(p),ierror )
166 ENDIF
167 ENDIF
168 ENDDO
169 iads(nspmd+1)=l
170C Recieve
171 l=0
172 ideb = 0
173
174 DO p=1, nspmd
175 l=0
176 siz=iadr(p+1)-iadr(p)
177 IF (siz > 0) THEN
178 msgtyp = msgoff
179 CALL mpi_recv( bbufr(iadr(p)),siz,real,it_spmd(p),msgtyp,
180 * spmd_comm_world,status,ierror )
181 DO nin=1,ninter
182 nty =ipari(7,nin)
183 inacti =ipari(22,nin)
184
185 nb = nsnfi(nin)%P(p)
186
187 IF((nty==7.and.ipari(34,nin)==-2.and.inacti==7).OR.
188 . (nty==22.and.ipari(34,nin)==-2.and.inacti==7)) THEN
189
190 IF (nb > 0)THEN
191 DO k=1,nb
192 i18kafi(nin)%P(1,ideb(nin)+k)=bbufr(iadr(p)+l)
193 i18kafi(nin)%P(2,ideb(nin)+k)=bbufr(iadr(p)+l+1)
194 i18kafi(nin)%P(3,ideb(nin)+k)=bbufr(iadr(p)+l+2)
195 mtfi_pene(nin)%P(ideb(nin)+k)=bbufr(iadr(p)+l+3)
196 mtfi_penemin(nin)%P(ideb(nin)+k)=bbufr(iadr(p)+l+4)
197 mtfi_n(nin)%P(1,ideb(nin)+k)=bbufr(iadr(p)+l+5)
198 mtfi_n(nin)%P(2,ideb(nin)+k)=bbufr(iadr(p)+l+6)
199 mtfi_n(nin)%P(3,ideb(nin)+k)=bbufr(iadr(p)+l+7)
200 l=l+8
201 ENDDO
202 ENDIF
203 ENDIF
204 ideb(nin)=ideb(nin)+nb
205 ENDDO
206 ENDIF
207 ENDDO
208
209C Fin du send
210 DO p = 1, nspmd
211 IF (p==nspmd)THEN
212 siz=lensd-iads(p)
213 ELSE
214 siz=iads(p+1)-iads(p)
215 ENDIF
216 IF(siz>0) THEN
217 CALL mpi_wait(req_si(p),status,ierror)
218 ENDIF
219 ENDDO
220
221 DO k=1,numnod
222 IF(tagpene(k)/=0)THEN
223 mtf(11,k)=mtf(11,k)*(1-em6)
224 ENDIF
225 ENDDO
226 IF (ALLOCATED(bbufs)) DEALLOCATE(bbufs)
227 IF (ALLOCATED(bbufr)) DEALLOCATE(bbufr)
228
229#endif
230 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
message_mod
Definition message_mod.F:1249
tri7box::i18kafi
type(real_pointer2), dimension(:), allocatable i18kafi
Definition tri7box.F:459
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::mtfi_pene
type(real_pointer), dimension(:), allocatable mtfi_pene
Definition tri7box.F:449
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::mtfi_n
type(real_pointer2), dimension(:), allocatable mtfi_n
Definition tri7box.F:459
tri7box::mtfi_penemin
type(real_pointer), dimension(:), allocatable mtfi_penemin
Definition tri7box.F:449
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