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
112! Loop on send and Recv : NSPMD*NSPMD communications
113! Since there is not collective asynchronous communication
114! with msmpi.
115
116 ALLOCATE(my_struct%TAB(stab),stat=ierror)
117 ALLOCATE(my_struct%BUFFER_TAB(stab,nspmd),stat=ierror)
118 ALLOCATE(my_struct%BUFFER_VAL(nspmd) ,stat=ierror)
119 ALLOCATE(my_struct%RQ_SEND_VAL(nspmd),stat=ierror)
120 ALLOCATE(my_struct%RQ_RECV_VAL(nspmd),stat=ierror)
121 ALLOCATE(my_struct%RQ_SEND_TAB(nspmd),stat=ierror)
122 ALLOCATE(my_struct%RQ_RECV_TAB(nspmd),stat=ierror)
123
124 my_struct%LENGTH_TAB = stab
125 my_struct%VAL = val
126 my_struct%TAB(1:stab) = tab(1:stab)
127 my_struct%BUFFER_VAL(ispmd+1) = val
128 my_struct%BUFFER_TAB(1:stab,ispmd+1) = tab(1:stab)
129
130
131 DO p = 1, nspmd
132 IF( p /= ispmd +1 ) THEN
133 msgtyp = 17000
134 CALL mpi_irecv(
135 1 my_struct%BUFFER_VAL(p) ,1,real,it_spmd(p),msgtyp,
136 2 spmd_comm_world,my_struct%RQ_RECV_VAL(p),ierror)
137
138 msgtyp = 17001
139 CALL mpi_irecv(
140 1 my_struct%BUFFER_TAB(1,p),my_struct%LENGTH_TAB,mpi_integer,it_spmd(p),msgtyp,
141 2 spmd_comm_world,my_struct%RQ_RECV_TAB(p),ierror)
142 ENDIF
143 ENDDO
144 DO p = 1, nspmd
145 IF( p /= ispmd +1 ) THEN
146 msgtyp = 17000
147 CALL mpi_isend(
148 1 my_struct%VAL ,1,real,it_spmd(p),msgtyp,
149 2 spmd_comm_world,my_struct%RQ_SEND_VAL(p),ierror)
150
151 msgtyp = 17001
152 CALL mpi_isend(
153 1 my_struct%TAB,my_struct%LENGTH_TAB,mpi_integer,it_spmd(p),msgtyp,
154 2 spmd_comm_world,my_struct%RQ_SEND_TAB(p),ierror)
155 ENDIF
156 ENDDO
157
158#endif
159 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:1257

◆ 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 171 of file mpi_tools_mod.F.

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