OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
mpi_tools_mod Module Reference

Data Types

type  mpi_min_real_struct

Functions/Subroutines

subroutine mpi_min_real_begin (val, tab, stab, my_struct)
subroutine mpi_min_real_end (val, tab, stab, my_struct)

Function/Subroutine Documentation

◆ mpi_min_real_begin()

subroutine mpi_tools_mod::mpi_min_real_begin ( intent(in) val,
integer, dimension(stab), intent(in) tab,
integer, intent(in) stab,
type(mpi_min_real_struct), intent(inout) my_struct )

Definition at line 72 of file mpi_tools_mod.F.

73C-----------------------------------------------
74C M o d u l e s
75C-----------------------------------------------
76 USE message_mod
77C-----------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80 USE spmd_comm_world_mod, ONLY : spmd_comm_world
81#include "implicit_f.inc"
82#include "r4r8_p.inc"
83C-----------------------------------------------
84C M e s s a g e P a s s i n g
85C-----------------------------------------------
86#include "spmd.inc"
87C-----------------------------------------------
88C C o m m o n B l o c k s
89C-----------------------------------------------
90#include "com01_c.inc"
91#include "com04_c.inc"
92#include "scr02_c.inc"
93#include "scr18_c.inc"
94#include "task_c.inc"
95#include "units_c.inc"
96#include "warn_c.inc"
97#include "timeri_c.inc"
98C-----------------------------------------------
99C D u m m y A r g u m e n t s
100C-----------------------------------------------
101 my_real, INTENT(IN) :: val ! value to be minimized
102 INTEGER, INTENT(IN) :: STAB !size of integer tab
103 INTEGER, INTENT(IN) :: TAB(STAB) !Tab of integer to send
104 TYPE(MPI_MIN_REAL_STRUCT), INTENT(INOUT) :: MY_STRUCT
105C-----------------------------------------------
106C L o c a l V a r i a b l e s
107C-----------------------------------------------
108 INTEGER P,IERROR
109 INTEGER MSGTYP
110#ifdef MPI
111 INTEGER STATUS (MPI_STATUS_SIZE)
112
113! Loop on send and Recv : NSPMD*NSPMD communications
114! Since there is not collective asynchronous communication
115! with msmpi.
116
117 ALLOCATE(my_struct%TAB(stab),stat=ierror)
118 ALLOCATE(my_struct%BUFFER_TAB(stab,nspmd),stat=ierror)
119 ALLOCATE(my_struct%BUFFER_VAL(nspmd) ,stat=ierror)
120 ALLOCATE(my_struct%RQ_SEND_VAL(nspmd),stat=ierror)
121 ALLOCATE(my_struct%RQ_RECV_VAL(nspmd),stat=ierror)
122 ALLOCATE(my_struct%RQ_SEND_TAB(nspmd),stat=ierror)
123 ALLOCATE(my_struct%RQ_RECV_TAB(nspmd),stat=ierror)
124
125 my_struct%LENGTH_TAB = stab
126 my_struct%VAL = val
127 my_struct%TAB(1:stab) = tab(1:stab)
128 my_struct%BUFFER_VAL(ispmd+1) = val
129 my_struct%BUFFER_TAB(1:stab,ispmd+1) = tab(1:stab)
130
131
132 DO p = 1, nspmd
133 IF( p /= ispmd +1 ) THEN
134 msgtyp = 17000
135 CALL mpi_irecv(
136 1 my_struct%BUFFER_VAL(p) ,1,real,it_spmd(p),msgtyp,
137 2 spmd_comm_world,my_struct%RQ_RECV_VAL(p),ierror)
138
139 msgtyp = 17001
140 CALL mpi_irecv(
141 1 my_struct%BUFFER_TAB(1,p),my_struct%LENGTH_TAB,mpi_integer,it_spmd(p),msgtyp,
142 2 spmd_comm_world,my_struct%RQ_RECV_TAB(p),ierror)
143 ENDIF
144 ENDDO
145 DO p = 1, nspmd
146 IF( p /= ispmd +1 ) THEN
147 msgtyp = 17000
148 CALL mpi_isend(
149 1 my_struct%VAL ,1,real,it_spmd(p),msgtyp,
150 2 spmd_comm_world,my_struct%RQ_SEND_VAL(p),ierror)
151
152 msgtyp = 17001
153 CALL mpi_isend(
154 1 my_struct%TAB,my_struct%LENGTH_TAB,mpi_integer,it_spmd(p),msgtyp,
155 2 spmd_comm_world,my_struct%RQ_SEND_TAB(p),ierror)
156 ENDIF
157 ENDDO
158
159#endif
160 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_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
message_mod
Definition message_mod.F:1249

◆ mpi_min_real_end()

subroutine mpi_tools_mod::mpi_min_real_end ( intent(inout) val,
integer, dimension(stab), intent(inout) tab,
integer, intent(in) stab,
type(mpi_min_real_struct), intent(inout) my_struct )

Definition at line 172 of file mpi_tools_mod.F.

173C-----------------------------------------------
174C M o d u l e s
175C-----------------------------------------------
176 USE message_mod
177C-----------------------------------------------
178C I m p l i c i t T y p e s
179C-----------------------------------------------
180 USE spmd_comm_world_mod, ONLY : spmd_comm_world
181#include "implicit_f.inc"
182#include "r4r8_p.inc"
183C-----------------------------------------------
184C M e s s a g e P a s s i n g
185C-----------------------------------------------
186#include "spmd.inc"
187C-----------------------------------------------
188C C o m m o n B l o c k s
189C-----------------------------------------------
190#include "com01_c.inc"
191#include "com04_c.inc"
192#include "scr02_c.inc"
193#include "scr18_c.inc"
194#include "task_c.inc"
195#include "units_c.inc"
196#include "warn_c.inc"
197#include "timeri_c.inc"
198C-----------------------------------------------
199C D u m m y A r g u m e n t s
200C-----------------------------------------------
201 my_real, INTENT(INOUT) :: val ! value to be minimized
202 INTEGER, INTENT(IN) :: STAB !size of integer tab
203 INTEGER, INTENT(INOUT) :: TAB(STAB) !Tab of integer to send
204 TYPE(MPI_MIN_REAL_STRUCT), INTENT(INOUT) :: MY_STRUCT
205C-----------------------------------------------
206C L o c a l V a r i a b l e s
207C-----------------------------------------------
208 INTEGER P,PMIN,IERROR
209 INTEGER MSGTYP
210#ifdef MPI
211 INTEGER STATUS (MPI_STATUS_SIZE)
212
213 ! WAIT SEND & RECV
214 DO p=1,nspmd
215 IF(ispmd + 1 /= p) THEN
216 CALL mpi_wait(my_struct%RQ_SEND_VAL(p),status,ierror)
217 CALL mpi_wait(my_struct%RQ_SEND_TAB(p),status,ierror)
218 CALL mpi_wait(my_struct%RQ_RECV_VAL(p),status,ierror)
219 CALL mpi_wait(my_struct%RQ_RECV_TAB(p),status,ierror)
220 ENDIF
221 ENDDO
222
223
224 ! Find the minimum value of VAL and the processor that has it
225 pmin = 1
226 val = my_struct%BUFFER_VAL(1)
227 DO p=2,nspmd
228 IF(val > my_struct%BUFFER_VAL(p)) THEN
229 val = my_struct%BUFFER_VAL(p)
230 pmin = p
231 ENDIF
232 ENDDO
233
234 ! TAB <- TAB of the processor that has the mini. value of VAL
235 tab(1:stab) = my_struct%BUFFER_TAB(1:stab,pmin)
236
237 DEALLOCATE(my_struct%TAB)
238 DEALLOCATE(my_struct%BUFFER_TAB)
239 DEALLOCATE(my_struct%BUFFER_VAL )
240 DEALLOCATE(my_struct%RQ_SEND_VAL)
241 DEALLOCATE(my_struct%RQ_RECV_VAL)
242 DEALLOCATE(my_struct%RQ_SEND_TAB)
243 DEALLOCATE(my_struct%RQ_RECV_TAB)
244
245#endif
246 RETURN
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525