PROGRAM main
    USE double
    USE mpi
    IMPLICIT NONE
    INTEGER, PARAMETER :: size = 3
    INTEGER, DIMENSION(size) :: source
    INTEGER, DIMENSION(size), ASYNCHRONOUS :: result
    INTEGER :: nprocs, myrank, info, window, elem_size, error, i

    CALL MPI_Init(error)
    CALL MPI_Comm_size(MPI_COMM_WORLD,nprocs,error)
    IF (nprocs < size) THEN
        PRINT *, 'Invalid number of processes'
        CALL MPI_Abort(MPI_COMM_WORLD,1,error)
    END IF
    CALL MPI_Comm_rank(MPI_COMM_WORLD,myrank,error)
    source = (/ (10*(myrank+1)+i, i = 1,size) /)

    CALL MPI_Info_create(info,error)
    CALL MPI_Info_set(info,"no_locks","true",error)
    CALL MPI_Sizeof(result,elem_size,error)
    CALL MPI_Win_create(result,    &
        INT(elem_size*size,KIND=MPI_ADDRESS_KIND),elem_size,    &
        info,MPI_COMM_WORLD,window,error)

    WRITE (*,"('Processor ',I0,' initial data',100(1X,I0))") myrank,source
    result = 0    ! Note the position
    CALL MPI_Win_fence(MPI_MODE_NOPRECEDE,window,error)
    CALL MPI_Put(source(1),1,MPI_INTEGER,myrank,    &
        0_MPI_ADDRESS_KIND,1,MPI_INTEGER,window,error)
    CALL MPI_Put(source(2),1,MPI_INTEGER,MOD(myrank+1,nprocs),    &
        1_MPI_ADDRESS_KIND,1,MPI_INTEGER,window,error)
    CALL MPI_Put(source(3),1,MPI_INTEGER,MOD(myrank-1+nprocs,nprocs),    &
        2_MPI_ADDRESS_KIND,1,MPI_INTEGER,window,error)
    CALL MPI_Win_fence(IOR(MPI_MODE_NOSUCCEED,MPI_MODE_NOPUT),window,error)
    WRITE (*,"('Processor ',I0,' now has data',100(1X,I0))") myrank,result

    CALL MPI_Win_free(window,error)
    CALL MPI_Info_free(info,error)
    CALL MPI_Finalize(error)
END PROGRAM main
