[mpich-discuss] Internal memory allocation error?

[Brian Harker]

Hi Gib-

Well, no dice.  I still get the same error.  Argh.

On Mon, Oct 20, 2008 at 8:35 AM, Brian Harker <brian.harker at gmail.com> wrote:
> Hi Gib-
>
> Thanks for the idea, it's now running by dispatching full columns at a
> time, so maybe I'll avoid the error, since the number of sends and
> receives is drastically reduced.  I'll keep you posted.
>
> On Sun, Oct 19, 2008 at 7:17 PM, Gib Bogle <g.bogle at auckland.ac.nz> wrote:
>> 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
>>>>>
>>>>>
>>>>
>>>
>>>
>>>
>>
>>
>
>
>
> --
> Cheers,
> Brian
> brian.harker at gmail.com
>
>
> "In science, there is only physics; all the rest is stamp-collecting."
>
> -Ernest Rutherford
>



-- 
Cheers,
Brian
brian.harker at gmail.com


"In science, there is only physics; all the rest is stamp-collecting."

-Ernest Rutherford