!===============================================================================
!
! bgl_process_mapping.F90 - adjust domain decomposition and 
!                           process mapping to Blue Gene topology
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2010 Hinnerk Stueben
!
! This file is part of BQCD -- Berlin Quantum ChromoDynamics program
!
! BQCD is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! BQCD is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with BQCD.  If not, see <http://www.gnu.org/licenses/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

subroutine bgl_process_mapping()
#ifndef NONMPI
  use module_input
  use module_function_decl
  implicit none
  include 'mpif.h'

  integer :: comm, ndims, size, size2, ierror 
  integer :: dims(4), periods(4), coords(4), coords2(4)
  integer :: minloc, maxloc, middleloc

  integer, external :: bgl_cart_comm_create
  character(MPI_MAX_PROCESSOR_NAME) :: name
  integer :: len_name

  if (bgl_cart_comm_create(size, ndims, dims, periods, coords) /= 0) return

  ASSERT(ndims == 4)
  ASSERT(size == num_pes())

  maxloc = 2
  if (dims(3) > dims(maxloc)) maxloc = 3
  if (dims(4) > dims(maxloc)) maxloc = 4

  minloc = maxloc
  if (dims(2) <= dims(minloc) .and. maxloc /= 2) minloc = 2
  if (dims(3) <= dims(minloc) .and. maxloc /= 3) minloc = 3
  if (dims(4) <= dims(minloc) .and. maxloc /= 4) minloc = 4

  if (minloc /= 2 .and. maxloc /= 2) middleloc = 2
  if (minloc /= 3 .and. maxloc /= 3) middleloc = 3
  if (minloc /= 4 .and. maxloc /= 4) middleloc = 4


!! change for d520 (and all other 'd's)
!!  input%processes(1) = dims(1)
!!  input%processes(2) = dims(minloc)
!!  input%processes(3) = dims(middleloc)
!!  input%processes(4) = dims(maxloc)
  
!!  input%process_mapping(1) = 1
!!  input%process_mapping(minloc) = 2
!!  input%process_mapping(middleloc) = 3
!!  input%process_mapping(maxloc) = 4

  call get_grid_internalat3(dims)
  input%processes(1) = dims(1)
  input%processes(2) = dims(2)
  input%processes(3) = dims(3)
  input%processes(4) = dims(4)

  input%process_mapping(1) = 1
  input%process_mapping(2) = 2
  input%process_mapping(3) = 3
  input%process_mapping(4) = 4
!! end change for d520


!  input%process_mapping(1) = 1
!  input%process_mapping(2) = minloc
!  input%process_mapping(3) = middleloc
!  input%process_mapping(4) = maxloc

  if (my_pe() == 0) then
     write(0,*) "bgl_process_mapping(): dims: ", dims
     write(0,*) "bgl_process_mapping(): locs: ", minloc, middleloc, maxloc
     write(0,*) "bgl_process_mapping(): processes: ", input%processes
     write(0,*) "bgl_process_mapping(): process_mapping: ", input%process_mapping
  endif


  call mpi_get_processor_name(name, len_name, ierror)
  call unlex_perm(my_pe(), DIM, coords2, input%processes, input%process_mapping)

  write(0,"(x,a,i6,2a,2(a,4i4))") &
        "bgl_process_mapping(): rank = ", my_pe(), &
                              " name = ", name(1:len_name), &
                              " my_coord = ", coords2, &
                              " bgl_coord = ", coords

  size2 = input%processes(1) * input%processes(2) * &
          input%processes(3) * input%processes(4)  

  ASSERT(size == size2)
#endif
end

