34
35
36
37
38
39
40
41
42
45
46
47
48 USE spmd_comm_world_mod, ONLY : spmd_comm_world
49#include "implicit_f.inc"
50
51
52
53#include "spmd.inc"
54
55
56
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "task_c.inc"
60
61
62
63 INTEGER, INTENT(in) :: NIN
64 INTEGER, INTENT(in) :: ITIED
65 INTEGER, DIMENSION(NINTER+1,NSPMD+1), INTENT(in) :: ISENDTO,IRCVFROM
66 TYPE(), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM
67 type(component_), dimension(ninter), intent(inout) :: component
68
69
70
71#ifdef MPI
72 INTEGER :: ,J,KK,IJK,KJI
73 INTEGER :: P,P_LOC
74 INTEGER IERROR1,STATUS(MPI_STATUS_SIZE),
75 INTEGER :: LOC_PROC
76 INTEGER :: MSGOFF, MSGOFF2, MSGOFF3, MSGOFF4, MSGOFF5
77 INTEGER :: MSGTYP,INFO
78 LOGICAL :: NEED_TO_RCV
79
80 DATA msgoff/6021/
81 DATA msgoff2/6022/
82 DATA msgoff3/6023/
83 DATA msgoff4/6024/
84 DATA msgoff5/6025/
85
86
87 loc_proc = ispmd + 1
88 IF(ircvfrom(nin,loc_proc)/=0) THEN
89
90
91 DO p_loc = 1,sort_comm(nin)%PROC_NUMBER
92 p = sort_comm(nin)%PROC_LIST(p_loc)
94
95
96 IF(isendto(nin,p)/=0) THEN
97 IF(loc_proc/=p) THEN
98 need_to_rcv = .true.
99 if(.not.component(nin)%proc_comp(p)%need_comm_s) need_to_rcv = .false.
100 IF(itied/=0) need_to_rcv = .true.
101 IF(need_to_rcv) THEN
102 msgtyp = msgoff3
103 sort_comm(nin)%NBRECV_NB=sort_comm(nin)%NBRECV_NB+1
104 sort_comm(nin)%RECV_NB(sort_comm(nin)%NBRECV_NB)=p
106 . msgtyp,spmd_comm_world,sort_comm(nin)%REQUEST_NB_R(sort_comm(nin)%NBRECV_NB),ierror)
107 ENDIF
108 ENDIF
109 ENDIF
110
111 ENDDO
112
113 ENDIF
114
115
116#endif
117 RETURN
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
type(int_pointer), dimension(:), allocatable nsnfi