source: branches/DEV_r2460_v3_3beta_NOL/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90 @ 2462

  MODULE mod_ioclient_para
    INTEGER,PARAMETER :: color_client=1
    INTEGER,PARAMETER :: color_server=2 
    INTEGER,SAVE      :: iocomm
    INTEGER,SAVE      :: iosize
    INTEGER,SAVE      :: iorank
    INTEGER,SAVE      :: server_rank
    INTEGER,SAVE      :: intracomm 
  CONTAINS
  
  
  SUBROUTINE Init_parallel
  USE mpitrace
  USE mod_ioserver_namelist
#if defined key_oasis3 || defined key_oasis4
  USE mod_prism_get_comm  
#endif
  USE mpi_mod
  USE mod_event_parameters
  IMPLICIT NONE
    INTEGER :: NEW_COMM
    INTEGER :: ierr
    INTEGER :: global_rank
    INTEGER :: global_size
    INTEGER :: mpi_rank
    INTEGER :: mpi_size
    INTEGER :: nb_server_io  
    INTEGER,ALLOCATABLE :: proc_color(:) 
    INTEGER :: i, ix, jpni_reg, jpnj_reg
    INTEGER :: div,remain
    INTEGER :: group_color
    INTEGER :: Comm_client_server
    CHARACTER(LEN=6) :: oasis_server_id
    LOGICAL :: ln_around, ln_use_allproc
    
    IF (using_oasis) THEN
      oasis_server_id=server_id
      PRINT *,'prism_get_intracomm'
#if defined key_oasis3 || defined key_oasis4
      CALL prism_get_intracomm(Comm_client_server,oasis_server_id,ierr)
#endif
    ELSE
      CALL MPI_INIT(ierr)
      Comm_client_server=MPI_COMM_WORLD
    ENDIF

    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)

    CALL MPI_COMM_SPLIT(Comm_client_server,color_client,global_rank,intracomm,ierr)
    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)

    nb_server_io=global_size-mpi_size
!   
! Need to be cleverer at setting group_colour when jpni*jpnj /= jpnij
! nregproc_in holds the list of equivalent ranks in a jpni by jpnj decomposition
! which has retained the land-only areas. If jpni*jpnj= jpnij then nregproc_in(mpi_size)
! should equal mpi_size-1 and nregproc_in(mpi_rank+1) = mpi_rank for all mpi_rank.
!
    ln_use_allproc = .true.
    ALLOCATE(nregproc_in(mpi_size))
    INQUIRE (file='layout.dat', exist=ln_around)
    IF (ln_around) THEN
! use it
     OPEN(UNIT=123,FILE='layout.dat')
     READ(123,'(48X,2i8,/)',ERR=606,END=606) jpni_reg, jpnj_reg
     do ix = 1,mpi_size
      READ(123,'(45X,I5)',ERR=606,END=606) nregproc_in(ix)
     end do
     ln_use_allproc = .false.
 606 CLOSE(123)
    ENDIF
    IF ( ln_use_allproc ) THEN
!
! Either layout.dat does not exist or the reading of nregproc_in has failed.
! Default to regular decomposition with no omitted land-only regions.
!
     do ix = 1,mpi_size
      nregproc_in(ix) = ix - 1
     end do
!
! jpni_reg and jpnj_reg are not known; just have to make sure jpni_reg*jpnj_reg=mpi_size
!
     jpni_reg=mpi_size
     jpnj_reg=1
    ENDIF

    div=(jpni_reg*jpnj_reg)/nb_server_io
    remain=MOD(jpni_reg*jpnj_reg,nb_server_io)
 
!
! Note need to add 1 to mpi_rank when indexing nregproc_in since nregproc_in is 
! indexed 1 to mpi_size but mpi_rank ranges from 0 to mpi_size-1
!
    IF (nregproc_in(mpi_rank+1)<remain*(div+1)) THEN
      group_color=nregproc_in(mpi_rank+1)/(div+1)
    ELSE
      group_color=(nb_server_io-1)-(jpni_reg*jpnj_reg - 1 -nregproc_in(mpi_rank+1))/div
    ENDIF

    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)
    
    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
    CALL MPI_COMM_RANK(iocomm,iorank,ierr)

    ALLOCATE(proc_color(0:iosize-1))
    CALL MPI_ALLGATHER(color_client,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
    
    DO i=0,iosize-1
      IF (proc_color(i)==color_server) THEN
        server_rank=i
        EXIT
      ENDIF
    ENDDO
    
    PRINT *,"Proces No",mpi_rank,"--> server",server_rank
  END SUBROUTINE Init_parallel
  
  SUBROUTINE Finalize_parallel
  USE mpi_mod
  IMPLICIT NONE
    INTEGER :: ierr
    
    CALL MPI_FINALIZE(ierr)

  END SUBROUTINE Finalize_parallel
  
  END MODULE mod_ioclient_para