[mpich-discuss] Internal memory allocation error?

[Gib Bogle]

Hi Brian,

You don't really send the data pixel-by-pixel do you?  If so that would be horrendously inefficient. 
  Why not send a row or column at a time?  Have I misunderstood you?

Cheers
Gib


Brian Harker wrote:
> Hi Rajeev-
> 
> The code I have posted is pared down quite a bit.  I print the
> "numsent" variable after each send and receive to make sure the
> correct pixel has been dispatched.  I guess I should mention that if I
> run the same program on some other data that I have, which has only
> 68K pixels, it works flawlessly.
> 
> On Sun, Oct 19, 2008 at 5:57 PM, Rajeev Thakur <thakur at mcs.anl.gov> wrote:
>> Brian,
>>      This code should not even need an Irecv because the master and slave
>> operate in lock step. And if you call Irecv followed by a Wait immediately,
>> you could as well call Recv.
>>
>> Since it fails with even one slave, run the 1 master 1 slave version and add
>> print statements after the sends and receives to see how many sends and
>> receives are happening.
>>
>> Rajeev
>>
>>
>>> -----Original Message-----
>>> From: owner-mpich-discuss at mcs.anl.gov
>>> [mailto:owner-mpich-discuss at mcs.anl.gov] On Behalf Of Brian Harker
>>> Sent: Sunday, October 19, 2008 6:05 PM
>>> To: mpich-discuss at mcs.anl.gov
>>> Subject: Re: [mpich-discuss] Internal memory allocation error?
>>>
>>> Hi list-
>>>
>>> Here's my sample code for those that are wary of opening
>>> email attachments  :)  Didn't think about that until just now.
>>>
>>> PROGRAM mpi_main
>>>
>>> USE subroutines  ! contains subroutine "invert_pixel"
>>> IMPLICIT NONE
>>>
>>> INCLUDE "mpif.h"
>>>
>>> ! total number of pixels
>>> INTEGER, PARAMETER :: np = nx * ny   !nx,ny specified in
>>> module "subroutines"
>>>
>>> ! parameter at each pixel
>>> DOUBLE PRECISION :: par
>>>
>>> ! full-size parameter array
>>> DOUBLE PRECISION, DIMENSION(nx,ny) :: map
>>>
>>> ! pixel coordinates
>>> INTEGER, DIMENSION(2) :: pxl
>>>
>>> ! dummy termination message
>>> INTEGER, PARAMETER :: term = 0
>>>
>>> ! MPI-related
>>> INTEGER :: proc_id
>>> INTEGER :: proc_num
>>> INTEGER :: master
>>> INTEGER :: ierr
>>> INTEGER :: sender
>>> INTEGER :: tag
>>> INTEGER :: numsent
>>> INTEGER :: request
>>> INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
>>>
>>> ! local indices
>>> INTEGER :: i
>>>
>>> !********************************************************************!
>>> !************************** BEGIN PROGRAM ***************************!
>>> !********************************************************************!
>>> master = 0
>>>
>>> ! initialize MPI libraries...
>>> CALL MPI_Init( ierr )
>>> CALL MPI_Comm_size( MPI_COMM_WORLD, proc_num, ierr ) CALL
>>> MPI_Comm_rank( MPI_COMM_WORLD, proc_id, ierr )
>>>
>>> ! --------------------------------------------- !
>>> !             master process code               !
>>> ! --------------------------------------------- !
>>> IF ( proc_id == master ) THEN
>>>
>>>  ! dispatch first group of pixels to slave processes...
>>>  numsent = 0
>>>  DO i = 1, proc_num - 1
>>>
>>>   pxl(1) = INT(numsent/ny) + 1
>>>   pxl(2) = MOD(numsent,ny) + 1
>>>   CALL MPI_Send( pxl, 2, MPI_INTEGER, i, numsent+1,
>>> MPI_COMM_WORLD, ierr )
>>>   numsent = numsent + 1
>>>
>>>  END DO
>>>
>>>  mstr: DO
>>>
>>>         ! receive inferred parameter back from a slave...
>>>         CALL MPI_Recv( par, 1, MPI_DOUBLE_PRECISION,
>>> MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr )
>>>         sender = status(MPI_SOURCE)
>>>         tag = status(MPI_TAG)
>>>
>>>         ! assemble into full-size array...
>>>         x = INT(tag/ny) + 1
>>>         y = MOD(tag,ny) + 1
>>>
>>>         map(x,y) = par
>>>
>>>         IF ( tag == np ) THEN
>>>          ! all done, send termination message...
>>>          DO j = 1, proc_num - 1
>>>           CALL MPI_Send( term, 1, MPI_INTEGER, j, 0,
>>> MPI_COMM_WORLD, ierr )
>>>          END DO
>>>          EXIT mstr
>>>         END IF
>>>
>>>         ! send the next available pixel to same slave...
>>>         pxl(1) = INT((numsent+1) / ny) + 1
>>>         pxl(2) = MOD((numsent+1), ny) + 1
>>>
>>>         CALL MPI_Send( pxl, 2, MPI_INTEGER, sender,
>>> numsent+1, MPI_COMM_WORLD, ierr )
>>>         numsent = numsent + 1
>>>
>>>        END DO mstr
>>> ! --------------------------------------------- !
>>> !              slave process code               !
>>> ! --------------------------------------------- !
>>> ELSE
>>>
>>>  slv: DO
>>>
>>>        ! receive pixel coordinates from master...
>>>        CALL MPI_Irecv( pxl, 2, MPI_INTEGER, master,
>>> MPI_ANY_TAG, MPI_COMM_WORLD, request, ierr )
>>>        CALL MPI_Wait( request, status, ierr )
>>>        tag = status(MPI_TAG)
>>>        IF ( tag == 0 ) THEN
>>>         ! all done, exit program...
>>>         EXIT slv
>>>        END IF
>>>
>>>        ! call genetic algorithm for inversion...
>>>        CALL invert_pixel( pxl, par )
>>>
>>>        ! send parameter result back to master...
>>>        CALL MPI_Send( par, 1, MPI_DOUBLE_PRECISION, master,
>>> tag, MPI_COMM_WORLD, ierr )
>>>       END DO slv
>>>
>>> END IF
>>>
>>> ! shut down MPI...
>>> CALL MPI_Finalize( ierr )
>>> WRITE(*,*) ""
>>> IF ( ierr == 0 ) WRITE(*,*) "Goodbye from process",proc_id
>>>
>>> !********************************************************************!
>>> !**************************** END PROGRAM ***************************!
>>> !********************************************************************!
>>>
>>> STOP
>>> END PROGRAM mpi_main
>>>
>>>
>>>
>>>
>>> --
>>> Cheers,
>>> Brian
>>> brian.harker at gmail.com
>>>
>>>
>>> "In science, there is only physics; all the rest is stamp-collecting."
>>>
>>> -Ernest Rutherford
>>>
>>>
>>
> 
> 
>