I'm writing a halo-exchange routine that looks like this:
halo exchange diagram, example with 3 processors
where non-blocking send/recv calls are used as described by the following pseudo-code:
mpi_irecv from left_neighbour ( + same for right neighbour)
pack data and mpi_isend to left_neighbour ( + same for right neighbour)
mpi_wait(recv_request from left_neighbour) and unpack ( + same for right neighbour)
mpi_wait(send_request to left_neighbour) ( + same for right neighbour)
This works fine in all cases, except for the specific case where I request two processors, and the boundaries are periodic. In this situation the data is mixed, i.e. recv_buffer_left has the data I expect recv_buffer_right to have, and v.v.
The rank for the left & right neighbours are the same in this case, so I assume I'm missing some subtlety in the request handles/tags? The code is below, would appreciate any thoughts!
! --- 1. issue non-blocking receives
if ( left_neighbour_exists ) call mpi_irecv( recv_buffer_left, buffer_size, MPI_REAL, left_neighbour, itag, world_comm, request_recv_left, ierr )
if ( right_neighbour_exists ) call mpi_irecv( recv_buffer_right, buffer_size, MPI_REAL, right_neighbour, itag, world_comm, request_recv_right, ierr )
! --- 2. pack for sending, then issue non-blocking sends
call pack_data( my_data, send_buffer_left, send_buffer_right )
!
if ( left_neighbour_exists ) call mpi_isend( send_buffer_left, buffer_size, MPI_REAL, left_neighbour, itag, world_comm, request_send_left, ierr )
if ( right_neighbour_exists ) call mpi_isend( send_buffer_right, buffer_size, MPI_REAL, right_neighbour, itag, world_comm, request_send_right, ierr )
! --- 3. wait for receives, then unpack
if ( left_neighbour_exists ) then
!
call mpi_wait( request_recv_left, status, ierr )
!
call unpack_data( recv_buffer_left, my_data )
!
endif
!
if ( right_neighbour_exists ) then
!
call mpi_wait( request_recv_right, status, ierr )
!
call unpack_data( recv_buffer_right, my_data )
!
endif
! --- 4. wait for sends
if ( left_neighbour_exists ) call mpi_wait( request_send_left, status, ierr )
if ( right_neighbour_exists ) call mpi_wait( request_send_right, status, ierr )
You need to be careful about message ordering. For more than 2 processes, there is no ambiguity as your up and down neighbours are the same. On two processes, however, your up and down neighbours are the same process so you are sending two messages to, and receiving two messages from, the same process.
The trick is to switch your sends around so you send right first then send left. The first send will match the first receive, which is a receive from the left.
Related
My IDE is Code::Blocks 17.2 with compiler GFortran 6.3.1
The all code is:
PROGRAM EES_TEST
USE , NON_INTRINSIC :: DERIVED_TYPE
IMPLICIT NONE
INTEGER :: I , ALLOC_ERR , DEALLOC_ERR
LOGICAL :: GLOBAL_ERR
CLASS ( TRONA ) , POINTER :: P_TRA
TYPE ( TRONA ) , ALLOCATABLE , TARGET :: TRAN(:)
IF ( .NOT. ALLOCATED ( TRAN ) ) ALLOCATE ( TRAN ( 2 ) , STAT = ALLOC_ERR )
IF ( ALLOC_ERR .NE. 0 ) STOP ("PROBLEM WITH MEMORY ALLOCATION - TRAN!!!")
OPEN ( UNIT = 15 , FILE = 'INPUT.TXT' , ACTION = 'READ' )
DO I = 1 , 2
P_TRA => TRAN ( I )
GLOBAL_ERR = P_TRA%UCI()
IF ( GLOBAL_ERR .EQV. .TRUE. ) STOP ("ERROR WITH READING FROM OUTPUT.TXT!")
END DO
CLOSE ( 15 )
IF ( ALLOCATED ( TRAN ) ) DEALLOCATE ( TRAN , STAT = DEALLOC_ERR )
IF ( DEALLOC_ERR .NE. 0 ) STOP ("PROBLEM WITH MEMORY DEALLOCATION - TRAN!!!")
END PROGRAM EES_TEST
MODULE DERIVED_TYPE
IMPLICIT NONE
TYPE , PUBLIC :: TRONA
PRIVATE
REAL :: Sn
REAL :: Vn
CONTAINS
PROCEDURE , PUBLIC :: UCI => UCI_POD_TRONA
PROCEDURE , PUBLIC :: TAKE_Sn => TAKE_POD_Sn
PROCEDURE , PUBLIC :: TAKE_Vn => TAKE_POD_Vn
END TYPE TRONA
PRIVATE :: UCI_POD_TRONA
PRIVATE :: TAKE_POD_Sn , TAKE_POD_Vn
CONTAINS
FUNCTION UCI_POD_TRONA ( THIS ) RESULT ( WRONG )
IMPLICIT NONE
CLASS ( TRONA ) :: THIS
LOGICAL :: WRONG
WRONG = .FALSE.
READ ( 15 , * , ERR = 100 ) THIS%Sn
READ ( 15 , * , ERR = 101 ) THIS%Vn
RETURN
100 WRITE (*,*) "WRONG FORMAT - INPUT 100!"
WRONG = .TRUE.
STOP
101 WRITE (*,*) "WRONG FORMAT - INPUT 101!"
WRONG = .TRUE.
STOP
END FUNCTION UCI_POD_TRONA
FUNCTION TAKE_POD_Sn ( THIS ) RESULT ( POD_Sn )
IMPLICIT NONE
CLASS ( TRONA ) :: THIS
REAL :: POD_Sn
POD_Sn = THIS%Sn
RETURN
END FUNCTION TAKE_POD_Sn
FUNCTION TAKE_POD_Vn ( THIS ) RESULT ( POD_Vn )
IMPLICIT NONE
CLASS ( TRONA ) :: THIS
REAL :: POD_Vn
POD_Vn = THIS%Vn
RETURN
END FUNCTION TAKE_POD_Vn
END MODULE DERIVED_TYPE
I am very new in object oriented programing in Fortran so I need an explanation about using the object pointer for calling methods from derived types. In this case I want to check is there any problem with memory leaking and if it is case is there method for checking how much memory was lost and in which line? Another thing is nullifying the derived type pointer. How to do that for this case?
Generally, unless you allocate something somewhere, you cannot have memory leaks. It is simply impossible. You can only leak something you allocate as a pointer target, nothing else.
In your code you have no allocate() for a pointer, so there cannot be any memory leaks.
For a memory leak to happen, two things must happen in sequence.
An anonymous pointer target must be allocated. That is possible only through the allocate statement
allocate(p_tra)
The pointer to the target is lost. Either it is redirected somewhere else
p_tra => somewhere_else
Or it ceases to exist, because it is a local variable of a subroutine that finishes or it is a component of a structure which is deallocated or similar...
You can always use GCC sanitizations -fssnitize=leak or valgrind to check for memory leaks.
Regarding the nulifying, just use the nulify statement or assign to null(). It is a pointer like any other.
p_tra => null()
This question already has an answer here:
Associated pointers in derived type? gFortran vs. Intel
(1 answer)
Closed 3 years ago.
I'm trying to learn the data-strcuture of a linked-list using Pointers in Fortran 90 on the platform of Win32/x86.
But when I runs the test-case that simply aims to build a list of 100 items, the program terminates with and error of 'Access violation'.
And the list is far from finished before the error occurs.
In debug run, it turns out that, at some point, the allocation of NEXT-Pointer fails.
I'm wondering why could this happen?
How could the linked-list be build successfully using pointers?
Codes are as follows:
TYPE Ptr
INTEGER :: I
TYPE(Ptr),POINTER :: PREV,NEXT
END TYPE Ptr
TYPE(Ptr),POINTER :: P
INTEGER :: IP,Err
ALLOCATE(P)
DO IP=1,100
P%I = IP
IF ( .NOT.ASSOCIATED(P%NEXT) ) THEN
ALLOCATE(P%NEXT, STAT=Err )
END IF
P%NEXT%PREV => P
P => P%NEXT
END DO
On UBUNTU with gfortran 7.2 your program compiled and ran just fine. There are, however two issues with your program, that may trip off your compiler:
After you allocate p the status of the pointers p%next and p%prev is undefined. It might be that your compiler then gets tripped on the statement IF(.not.associated(p%next)), as the status of p%next is undefined. Always nullify pointers before you use them or refer to them in any which way. Try:
program pointers
!
TYPE Ptr
INTEGER :: I
TYPE(Ptr),POINTER :: PREV,NEXT
END TYPE Ptr
!
TYPE(Ptr),POINTER :: P => NULL() ! Make sure all pointer are nullified
TYPE(Ptr),POINTER :: head => NULL()
TYPE(Ptr),POINTER :: temp => NULL()
INTEGER :: IP,Err
!
NULLIFY(P) ! This is identical to the nullify in the declaration statement
NULLIFY(head) ! I've added it to show both styles
NULLIFY(temp)
!
ALLOCATE(P)
NULLIFY(P%NEXT) ! Always nullify pointers
NULLIFY(P%PREV) ! Always nullify pointers
head => P ! To keep a header to your list is a good idea
!
DO IP=1,100
write(*,*) ip
P%I = IP*IP ! Trivial unimportant change
!
IF ( .NOT.ASSOCIATED(P%NEXT) ) THEN
ALLOCATE(P%NEXT, STAT=Err )
P%NEXT%I = ip+1 ! define entries
NULLIFY(P%NEXT%NEXT) ! for next node
NULLIFY(P%NEXT%PREV) ! for all elements of your TYPE
END IF
!
P%NEXT%PREV => P
P => P%NEXT
!
END DO
!
temp => head ! temporary pointer to navigate
DO WHILE( ASSOCIATED(temp) )
write(*,*) ' AT NODE ', temp%i
temp => temp%next
ENDDO
!
end program pointers
As pointed out by #Alexander Vogt, you loose the start of the list. I added a pointer called head to retain this beginning of the list. If you look at the output you will notice that the program actually makes a list of 100+1 entries, since you make p first, then you add 100 times a p%next.
I have found written
"A message can ONLY be received within the same communicator from which it was sent".
However, if I look at this picture
https://imgur.com/a/hYz4dWd
and then analyze this code
Send and Receive operations between communicators in MPI
use mpi !instead of include 'mpif.h'
implicit none
integer :: tag,ierr,rank,numtasks,color,new_comm,inter1,inter2
integer :: sendbuf,recvbuf,stat(MPI_STATUS_SIZE)
integer :: irank
!
tag = 22
sendbuf = 222
!
call MPI_Init(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,numtasks,ierr)
!
if (rank < 2) then
color = 0
else
color = 1
end if
!
call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,rank,new_comm,ierr)
!
if (color .eq. 0) then
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,2,tag,inter1,ierr)
!
call MPI_COMM_RANK(inter1,irank,ierr)
if(irank==0)then
call mpi_send(sendbuf,1,MPI_INT,0,tag,inter1,ierr)
end if
!
else if(color .eq. 1) then
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_COMM_WORLD,0,tag,inter2,ierr)
call MPI_COMM_RANK(inter2,irank,ierr)
if(irank==0)then
call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter2,stat,ierr)
if(ierr/=MPI_SUCCESS)print*,'Error in rec '
print*,'rec buff = ', recvbuf
end if
end if
!
call MPI_finalize(ierr)
end program h
to me it seems that I am communicating between two different communicators: inter1 and inter2. Turning to the picture attached, I am communicating from comm1 towards comm2.
The picture is unrelated to the sample code.
Looking at the code, one rank MPI_Send(..., inter1, ...) and an other MPI_Recv(..., inter2, ...).
What matters here is how inter1 and inter2 were created, and they both come from all the ranks invoking MPI_Intercomm_create(), so even if you use different variable names, they indeed refer to the same (and unique) inter-communicator.
Here is a more intuitive way the program could have been written
use mpi !instead of include 'mpif.h'
implicit none
integer :: tag,ierr,rank,numtasks,color,new_comm,inter,remote_leader
integer :: sendbuf,recvbuf,stat(MPI_STATUS_SIZE)
integer :: irank
!
tag = 22
sendbuf = 222
!
call MPI_Init(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,numtasks,ierr)
!
if (rank < 2) then
color = 0
remote_leader=2
else
color = 1
remote_leader=0
end if
!
call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,rank,new_comm,ierr)
!
call MPI_INTERCOMM_CREATE(new_comm,0,MPI_Comm_world,remote_leader,tag,inter,ierr)
call MPI_COMM_RANK(inter,irank,ierr)
if (irank.eq.0) then
if(color.eq.0) then
call mpi_send(sendbuf,1,MPI_INT,0,tag,inter,ierr)
else if(color.eq.1) then
call mpi_recv(recvbuf,1,MPI_INT,0,tag,inter,stat,ierr)
if(ierr/=MPI_SUCCESS)print*,'Error in rec '
print*,'rec buff = ', recvbuf
end if
end if
!
call MPI_finalize(ierr)
end program
Let's say I have a producer.go and consumer.go. The consumer.go reads from a UNIX named pipe, and the producer writes to the named pipe.
As expected, If you start up just one of the producer or consumer programs, it hangs because there's no reader or writer on the other side of the pipe.
Now, If I start both programs, then immediately CTRL-C from the consumer, the producer continues sending data to the pipe and as far as I can tell there's no limit to the size of that data (I've sent 80MB)
If I start the consumer program again (while the producer is still running), it starts pulling data off of the named pipe, but not the data that I "missed" while the consumer program was not running.
My question is: When a reader of a named pipe disconnects, what happens to the data that's sent to the named pipe?
Here are my consumer.go and producer.go programs:
consumer.go
package main
import (
"io"
"io/ioutil"
"log"
"os"
"syscall"
)
func main() {
syscall.Mkfifo("fifo0", 0777)
fp, err := os.OpenFile("fifo0", os.O_RDONLY, 0777)
if err != nil {
log.Fatalf("Could not open fifo0: %s", err)
}
tee := io.TeeReader(fp, os.Stdout)
ioutil.ReadAll(tee)
}
producer.go
package main
import (
"fmt"
"io"
"log"
"os"
"strings"
"time"
)
func main() {
dots := strings.Repeat(".", 990)
fifo, err := os.OpenFile("fifo0", os.O_WRONLY, 0777)
if err != nil {
log.Fatalf("Could not open fifo0: %s", err)
}
defer fifo.Close()
w := io.MultiWriter(os.Stdout, fifo)
for i := 0; i < 8000; i++ {
fmt.Fprintf(w, "%010d%s\n", i, dots)
time.Sleep(time.Millisecond * 10)
}
}
A FIFO requires at least one source and one destination for data to get transferred anywhere. A reader alone waits to pull from someone, and a writer alone waits to send to someone. In this way, there are no gaps in a one-to-one pipe.
So if you're still trying to read or write from one end of a disconnected or nonexistent pipe, the answer is that the data is going nowhere; the pipe is "blocked" and can hold no data of its own. So it depends on how your code handles this situation.
In producer.go, the loop continues to run even when there's no longer a connection. Because Fprintf or MultiWriter don't raise a code-stopping error for whatever reason. In this case you could either add a check in the loop or an event handler for the fifo object's disconnection.
The reason it seems that there's a gap of disappearing data, is because the loop continues to iterate for i and generate strings it can't send.
Does the "delete" statement below "doubly free" an object?
(...object_list is a global vector<object*>...)
vector< object * >::iterator it, eit, iter;
object *p_object;
vector< object * > dead_objects;
it = object_list_.begin();
eit = object_list_.end();
//---collect pointers of all dead objects to dead_objects vector
for ( ; it != eit; it++ )
{
p_object = *it;
if ( p_object->is_dead() == false )
continue;
dead_objects.push_back( p_object );
}
//---free every dead object from the global object_list
for ( iter = dead_objects.begin(); iter != dead_objects.end(); iter++ )
{
p_object = *iter;
it = object_list_.begin();
eit = object_list_.end();
for ( ; it != eit; it++ )
{
if ( *it != p_object )
continue;
object_list_.erase( it );
delete p_object;
break;
}
}
I ask the question because the erase() statement above should have called the destructor of an object and freed it already, shouldn't it?
erase() does call the destructor on the object, but the destructor of a pointer type (such as object * here) does nothing -- it does NOT call delete on the pointer. If you want it to call delete, you need to use some object (such as auto_ptr<object *>) which does call delete.
It would appear not; if you have a vector of pointers to objects, calling erase() to remove one of them simply removes the pointer from the vector. You are still required to delete it yourself - this is because STL containers are designed primarily to collect objects by value.
Just a couple of suggestions - IMO your code would be clearer if you used STL algorithms like std::find instead of looping over all your vectors by hand. I'm not sure what the point of dead_objects vs object_list is - you don't seem to gain anything by storing them in the temporary vector, but something may have been lost in copying the code to SO. And std::vector is not optimal for lots of random erasures like this since erase runs in linear time - std::remove followed by erase would be a more efficient approach. For example:
for(vector<object*>::iterator it = object_list.begin(); it != object_list.end(); ++it) {
if((*it)->is_dead()) {
delete *it;
*it = NULL;
}
}
object_list.erase(std::remove(object_list.begin(), object_list.end(), NULL), object_list.end());