de89d3bc
 dmayerich
Initial commit.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
!
! MPI alias definitions for serial machines.
!
!
! last revised: 15 January 2011
!
module mpidefs
implicit none
integer :: mpi_comm_world,ms_mpi_comm_world,ms_mpi_sum,ms_mpi_max,ms_mpi_min
contains
subroutine ms_mpi(mpi_command,mpi_recv_buf_i,mpi_recv_buf_r,mpi_recv_buf_c,mpi_recv_buf_dp, &
mpi_recv_buf_dc,mpi_send_buf_i,mpi_send_buf_r,mpi_send_buf_c, &
mpi_send_buf_dp,mpi_send_buf_dc,mpi_number,mpi_comm,mpi_group,mpi_rank,mpi_size, &
mpi_new_comm,mpi_new_group,mpi_new_group_list,mpi_operation)
integer, optional :: mpi_number,mpi_recv_buf_i(*),mpi_send_buf_i(*),mpi_comm,mpi_group,mpi_rank, &
mpi_size,mpi_new_comm,mpi_new_group,mpi_new_group_list(*),mpi_operation
integer :: stat(1)
real(4), optional :: mpi_recv_buf_r(*),mpi_send_buf_r(*)
real(8), optional :: mpi_recv_buf_dp(*),mpi_send_buf_dp(*)
complex(4), optional :: mpi_recv_buf_c(*),mpi_send_buf_c(*)
complex(8), optional :: mpi_recv_buf_dc(*),mpi_send_buf_dc(*)
character(*) :: mpi_command
integer :: type,ierr,comm,size,rank,group,newcomm
if(mpi_command.eq.'init') then
mpi_comm_world=1
return
endif
if(mpi_command.eq.'finalize') then
return
endif
if(present(mpi_comm)) then
comm=mpi_comm
else
comm=mpi_comm_world
endif
if(mpi_command.eq.'size') then
mpi_size=1
return
endif
if(mpi_command.eq.'rank') then
mpi_rank=0
return
endif
if(mpi_command.eq.'group') then
return
endif
if(mpi_command.eq.'incl') then
mpi_new_group=0
return
endif
if(mpi_command.eq.'create') then
mpi_new_comm=1
return
endif
if(mpi_command.eq.'barrier') then
return
endif
if(present(mpi_recv_buf_i).or.present(mpi_send_buf_i)) then
if(mpi_command.eq.'bcast'.or.mpi_command.eq.'send'.or.mpi_command.eq.'recv') then
return
endif
if(mpi_command.eq.'reduce'.or.mpi_command.eq.'allreduce') then
if(present(mpi_send_buf_i)) then
mpi_recv_buf_i(1:mpi_number)=mpi_send_buf_i(1:mpi_number)
endif
endif
return
endif
if(present(mpi_recv_buf_r).or.present(mpi_send_buf_r)) then
if(mpi_command.eq.'bcast'.or.mpi_command.eq.'send'.or.mpi_command.eq.'recv') then
return
endif
if(mpi_command.eq.'reduce'.or.mpi_command.eq.'allreduce') then
if(present(mpi_send_buf_r)) then
mpi_recv_buf_r(1:mpi_number)=mpi_send_buf_r(1:mpi_number)
endif
endif
return
endif
if(present(mpi_recv_buf_c).or.present(mpi_send_buf_c)) then
if(mpi_command.eq.'bcast'.or.mpi_command.eq.'send'.or.mpi_command.eq.'recv') then
return
endif
if(mpi_command.eq.'reduce'.or.mpi_command.eq.'allreduce') then
if(present(mpi_send_buf_c)) then
mpi_recv_buf_c(1:mpi_number)=mpi_send_buf_c(1:mpi_number)
endif
endif
return
endif
if(present(mpi_recv_buf_dp).or.present(mpi_send_buf_dp)) then
if(mpi_command.eq.'bcast'.or.mpi_command.eq.'send'.or.mpi_command.eq.'recv') then
return
endif
if(mpi_command.eq.'reduce'.or.mpi_command.eq.'allreduce') then
if(present(mpi_send_buf_dp)) then
mpi_recv_buf_dp(1:mpi_number)=mpi_send_buf_dp(1:mpi_number)
endif
endif
return
endif
if(present(mpi_recv_buf_dc).or.present(mpi_send_buf_dc)) then
if(mpi_command.eq.'bcast'.or.mpi_command.eq.'send'.or.mpi_command.eq.'recv') then
return
endif
if(mpi_command.eq.'reduce'.or.mpi_command.eq.'allreduce') then
if(present(mpi_send_buf_dc)) then
mpi_recv_buf_dc(1:mpi_number)=mpi_send_buf_dc(1:mpi_number)
endif
endif
return
endif
end subroutine ms_mpi
end module mpidefs
|
