program main

            implicit none

            include 'mpif.h'



            INTEGER IERR,MYRANK,NPROCS

            INTEGER LBX, LBY, ibx, iby, col, row

            INTEGER, DIMENSION(2) :: ISIZE, ISUBSIZE, ISTART

            INTEGER INEWTYPE, RESIZEDTYPE, REALSIZE

            INTEGER(KIND=MPI_ADDRESS_KIND) :: EXTENT,BEGIN

            integer :: i,ii, j,jj, k, N, NX, NY

            double precision,allocatable,dimension(:,:) :: x,xx,ISEND_X

            integer,allocatable,dimension(:) :: counts, displs



            integer,parameter :: N4=4

            integer :: NP

            integer :: get_arg_i1



        !   NP =  1  OK

        !   NP =  2  OK

        !   NP =  4  NG

        !   NP =  8  NG

        !   NP = 16  NG

            NP = get_arg_i1()



            N = 4

            LBX = 2

            LBY = 2



            CALL MPI_INIT(IERR)

            CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR)

            CALL MPI_COMM_RANK(MPI_COMM_WORLD,MYRANK,IERR)



            !write(*,*) "NPROCS=", NPROCS, "MYRANK=",MYRANK



            allocate( x(N,N), xx(N,N4*N) )

            allocate( ISEND_X(N/LBX, N/LBY) )

            allocate( counts( LBX*LBY ), displs( LBX*LBY ) )



        !    write(*,*) "point_01"



            if ( MYRANK == 0 ) then

                xx = 0

                x = reshape([(i,i=1,N*N)],[N,N])

            end if



            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

            CALL MPI_BCAST(x,N*N,MPI_DOUBLE_PRECISION,0,&
                           MPI_COMM_WORLD,IERR)



        !    write(*,*) "point_02"



            NX = N/LBX

            NY = N/LBY



        ! print x

            if ( MYRANK == 0 ) then

                !write(*,*) NX, NY

                do j=1,N

                    do i=1,N

                        write(*, '(f5.1)', advance='no') x(i,j)

                    enddo

                    print *

                enddo

                write(*,*)

            endif



            if( MYRANK == 0 ) then

                ibx = 0

                iby = 0

            else

                ibx = mod(MYRANK, LBX)

                iby = MYRANK / LBX

            endif



            do j=1,NY

                jj = iby*NY + j

                do i=1,NX

                    ii = ibx*NX + i

                    ISEND_X(i,j) = x(ii, jj)

        !            write(*,*) i,j, ii,jj,ISEND_X(i,j) x(ii, jj)

                enddo

            enddo

        !   ISEND_X = x(iby*NY+1:iby*NY+NY,ibx*NX+1:ibx*NX+NX)



        !    write(*,*) "point_03"



        !!! MPI grid setting !!!

            ISTART = [0, 0]

            ISIZE = [N, N]

            ISUBSIZE = [NX, NY]



            CALL MPI_TYPE_CREATE_SUBARRAY(2,ISIZE,ISUBSIZE,ISTART, &
                                          MPI_ORDER_FORTRAN, &
                                          MPI_DOUBLE_PRECISION,  &
                                          INEWTYPE,IERR)

            CALL MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION,REALSIZE,IERR)

            EXTENT = N*N*REALSIZE/NP

            BEGIN = 0

            CALL MPI_TYPE_CREATE_RESIZED(INEWTYPE,BEGIN,EXTENT, &
                                         RESIZEDTYPE,IERR)

            CALL MPI_TYPE_COMMIT(RESIZEDTYPE,IERR)



            counts = 1

            displs = NP*[0,1,2,3]



        ! print counts, displs

            !if( MYRANK == 0 ) then

                !write(*,*) 'counts= ', counts

                !write(*,*) 'displs= ' ,displs

            !endif





        !!!

            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

                !write(*,*) "MYRANK=",MYRANK, NX, NY, counts, displs

                   !do j=1,NY

                      !do i=1,NX

                          !write(*, '(f5.1)', advance='no') ISEND_X(i,j)

                      !enddo

                      !print *

                   !enddo

                   !print *

            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

            CALL MPI_ALLGATHERV(ISEND_X,NX*NY,MPI_DOUBLE_PRECISION, &

                               xx,counts,displs,RESIZEDTYPE,&
                               MPI_COMM_WORLD,IERR)





            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

            CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

        ! print xx

             if( MYRANK == 0 ) then

        !        write(*,*) "MYRANK=",MYRANK, x

                 do k=0,N4-1

                   do j=1,N

                      do i=1,N

                          write(*, '(f5.1)', advance='no') xx(i,j+k*N)

                      enddo

                      print *

                   enddo

                   print *

                 enddo

            endif

        !   enddo



            CALL MPI_TYPE_FREE(INEWTYPE,IERR)



            deallocate( x )

            deallocate( ISEND_X )

            deallocate( counts, displs )





            CALL MPI_FINALIZE(IERR)



        end program



        integer function get_arg_i1()

        character :: arg*100

        get_arg_i1 = 0

        if ( iargc () > 0 ) then

           call getarg( 1, arg )

            read(arg,*) get_arg_i1

        end if

        end function