source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ftest.F90 @ 4775

        program test
        implicit none
        include "mpif.h"

        integer ier

        integer sreq(10), sreq2(10), rreq(10), rreq2(10)
        integer sbuf(10), sbuf2(10), rbuf(10), rbuf2(10)
        integer tag
        integer status(MPI_STATUS_SIZE,10)
        integer i
        integer comm2;
        logical flag;
        character pname(MPI_MAX_PROCESSOR_NAME)
        integer pnamesize

        integer temp,position

        external my_op_func
        integer myop


        print *, 'Time=',mpi_wtime()

        call mpi_initialized(flag,ier)
        print *, 'MPI is initialized=',flag

        call mpi_init(ier)

        call mpi_get_processor_name(pname,pnamesize,ier)
        print *, 'proc name: "',pname(1:pnamesize),'"  size:',pnamesize


        call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)

        call mpi_initialized(flag,ier)
        print *, 'MPI is initialized=',flag




        do i=1,5
          tag= 100+i
          print *,  'Post receive tag ',tag

          call mpi_irecv( rbuf(i),1,MPI_INTEGER,0,tag, &
                          MPI_COMM_WORLD,rreq(i),ier)

        end do
        do i=1,5
!         tag=1100+i
!         print *,  'Post receive tag ',tag

          call mpi_irecv( rbuf2(i),1,MPI_INTEGER, &
                          MPI_ANY_SOURCE, MPI_ANY_TAG, &
                          comm2,rreq2(i),ier)

        end do


        do i=1,5
          sbuf(i)=10*i
          tag=100+i
          print *, 'Send ',sbuf(i),' tag ',tag

          call mpi_isend( sbuf(i),1,MPI_INTEGER,0,tag, &
                          MPI_COMM_WORLD,sreq(i),ier)
        end do


        do i=1,5
          sbuf2(i)=1000+10*i
          tag=1100+i
          print *, 'Send ',sbuf2(i),' tag ',tag

          call mpi_isend( sbuf2(i),1,MPI_INTEGER,0,tag, &
                          comm2,sreq2(i),ier)
        end do


        print *, 'Time=',mpi_wtime()
        call mpi_waitall(5,sreq,status,ier)
        print *,'sends on MPI_COMM_WORLD done'

        call mpi_waitall(5,rreq,status,ier)
        print *,'recvs on MPI_COMM_WORLD done'
        
        do i=1,5
          print *, 'Status source=',status(MPI_SOURCE,i), &
                   '  tag=',status(MPI_TAG,i)
        end do

        call mpi_waitall(5,sreq2,status,ier)
        print *,'sends on comm2 done'

        call mpi_waitall(5,rreq2,status,ier)
        print *,'recvs on comm2 done'

        do i=1,5
          print *, 'Status source=',status(MPI_SOURCE,i), &
                   '  tag=',status(MPI_TAG,i)
        end do


! pack/unpack

        position=0
        do i=1,5
          temp=100+i
          call mpi_pack(temp,1,MPI_INTEGER,sbuf,20,position,MPI_COMM_WORLD,ier)
        end do

        call mpi_isend(sbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,sreq(1),ier)
        call mpi_irecv(rbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,rreq(1),ier)
        call mpi_waitall(1,rreq,status,ier)

        print *,"Pack/send/unpack:"

        position=0
        do i=1,5
          call mpi_unpack( rbuf,20,position,temp,1,MPI_INTEGER, &
                           MPI_COMM_WORLD,ier)
          print *,temp
        end do

!
        print *,"Creating op"
        call mpi_op_create(my_op_func,.TRUE.,myop,ier)


        call mpi_finalize(ier)

        do i=1,5
          print *, 'Time=',mpi_wtime()
          call sleep(1)
        end do

        end




        function my_op_func(invec,inoutvec,len,type)
        integer invec(len),inoutvec(len)
        integer len,type

        return
        end function my_op_func