C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/eesupp/src/ini_threading_environment.F,v 1.7 2001/02/04 14:38:43 cnh Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CStartOfInterface
      SUBROUTINE INI_THREADING_ENVIRONMENT
C     /==========================================================\
C     | SUBROUTINE INI_THREADING_ENVIRONMENT                     |
C     | o Initialise multi-threaded environment.                 |
C     |==========================================================|
C     | Generally we do not start separate threads here.         |
C     | The separate threads a spawned at later on.              |
C     | Here we perform initialisation of data-structures        |
C     | that indicate which of the nSx x nSy tiles a thread is   |
C     | responsible for.                                         |
C     | The multiple threads are spawned in the top level MAIN   |
C     | routine.                                                 |
C     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
CEndOfInterface

C     == Local variables ==
C     bXPerThread - Blocks of size sNx per thread.
C     byPerThread - Blocks of size sNy per thread.
C     Thid        - Thread index. Temporary used in loops
C                   which set per. thread values on a 
C                   cartesian grid.
C     bxLo, bxHi  - Work vars. for thread index
C     byLo, byHi    range. bxLo is the lowest i index
C                   that a thread covers, bxHi is the
C                   highest i index. byLo is the lowest
C                   j index, byHi is the highest j index.
C     I, J        - Loop counter
C     msgBuf      - I/O buffer for reporting status information.
C     myThid      - Dummy thread id for use in printed messages
C                   ( this routine "INI_THREADING_ENVIRONMENT" is 
C                     called before multi-threading has started.)
      INTEGER bxPerThread
      INTEGER byPerThread
      INTEGER Thid
      INTEGER bxLo, bxHi
      INTEGER byLo, byHi
      INTEGER I, J, nT
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER myThid

C--   Set default for all threads of having no blocks to
C--   work on - except for thread 1.
      myBxLo(1) = 1
      myBxHi(1) = nSx
      myByLo(1) = 1
      myByHi(1) = nSy
      DO I = 2, MAX_NO_THREADS
       myBxLo(I) = 0
       myBxHi(I) = 0
       myByLo(I) = 0
       myByHi(I) = 0
      ENDDO
      myThid = 1
      commName(COMM_NONE) = 'none'
      commName(COMM_MSG ) = 'messages'
      commName(COMM_PUT ) = 'put'
      commName(COMM_GET ) = 'get'

C--   If there are multiple threads allocate different range of the
C--   nSx*nSy blocks to each thread.
C     For now handle simple case of no. blocks nSx = n*nTx and
C     no. blocks nSy = m*nTy ( where m and n are integer ). This
C     is handled by simply mapping threads to blocks in sequence
C     with the x thread index moving fastest. 
C     Later code which sets the thread number of neighboring blocks 
C     needs to be consistent with the code here.
      nThreads = nTx * nTy

C--   Initialise the barrier mechanisms
C     BAR2 will eventually replace barrier everywhere.
      CALL BARRIER_INIT
      DO I=1, MAX_NO_THREADS
       CALL BAR2_INIT(I)
      ENDDO

C--   Initialise exchange mechanism
      CALL EXCH_INIT

      IF   ( nThreads .NE. nTx*nTy ) THEN
       WRITE(msgBuf,'(A,A,A,I5,A,I5)') 
     &  'S/R INI_THREADING_ENVIRONMENT:',
     &  ' Total number of threads is not the same as nTx*nTy.',
     &  ' nTx * nTy = ',nTx*nTy,' nThreads = ',nThreads
       CALL PRINT_ERROR(msgBuf, myThid)
       eeBootError = .TRUE.
       STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
      ENDIF
      bxPerThread = nSx/nTx
      IF ( bxPerThread*nTx .NE. nSx ) THEN
       WRITE(msgBuf,'(A,A,A)') 
     &  'S/R INI_THREADING_ENVIRONMENT:',
     &  ' Number of blocks in X (nSx)',
     &  ' must be exact multiple of threads in X (nTx).'
       CALL PRINT_ERROR(msgBuf, myThid)
       eeBootError = .TRUE.
       STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
      ENDIF
      byPerThread = nSy/nTy
      IF ( byPerThread*nTy .NE. nSy ) THEN
       WRITE(msgBuf,'(A,A,A)') 
     &  'S/R INI_THREADING_ENVIRONMENT:',
     &  ' Number of blocks in Y (nSy)',
     &  ' must be exact multiple of threads in Y (nTy).'
       CALL PRINT_ERROR(msgBuf, myThid)
       eeBootError = .TRUE.
       STOP 'ABNORMAL END: S/R INI_THREADING_ENVIRONMENT'
      ENDIF
      IF ( .NOT. eeBootError ) THEN
       byLo = 1
       DO J=1,nTy
        byHi = byLo+byPerThread-1
        bxLo = 1
        DO I=1,nTx
         Thid = (J-1)*nTx+I
         bxHi = bxLo+bxPerThread-1
         myBxLo(Thid) = bxLo
         myBxHi(Thid) = bxHi
         myByLo(Thid) = byLo
         myByHi(Thid) = byHi
         bxLo = bxHi+1
        ENDDO
        byLo = byHi+1
       ENDDO
      ENDIF

      DO nT=1,nThreads
       CALL INI_COMMUNICATION_PATTERNS( nT )
      ENDDO

C--   Print mapping of threads to grid points.
      WRITE(msgBuf,'(A)') 
     &'// ======================================================'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &  SQUEEZE_RIGHT , 1)
      WRITE(msgBuf,'(A)') '// Mapping of tiles to threads'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &  SQUEEZE_RIGHT , 1)
C     o Write list of tiles each thread is responsible for
      WRITE(msgBuf,'(A)') 
     &'// ======================================================'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &  SQUEEZE_RIGHT , 1)
      DO I=1,nThreads
       WRITE(msgBuf,'(A,I4,A,4(I4,A1))') 
     & '// -o- Thread',I,', tiles (',
     & myBxLo(I),':',myBxHi(I),',',myByLo(I),':',myByHi(I),')'
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_BOTH , 1)
      ENDDO
      WRITE(msgBuf,'(A)')  ' '
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT , 1)

C     o For each tile print its communication method(s)
      WRITE(msgBuf,'(A)') 
     &'// ======================================================'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &  SQUEEZE_RIGHT , 1)
      WRITE(msgBuf,'(A)') '// Tile <-> Tile connectvity table'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &  SQUEEZE_RIGHT , 1)
      WRITE(msgBuf,'(A)') 
     &'// ======================================================'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &  SQUEEZE_RIGHT , 1)
      DO J=1,nSy
       DO I=1,nSx
        WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A)')  
     &   '//',' Tile number: ',tileNo(I,J),
     &   ' (process no. = ',myPid,')'
        CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT , 1)
C       o West communication details
        IF ( tileNoW(I,J).NE. NULL_TILE ) THEN
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
     &   '//        WEST: ',
     &   'Tile = ',tileNoW(I,J),
     &   ', Process = ',tilePidW(I,J),
     &   ', Comm = ',commName(tileCommModeW(I,J))
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
     &   '//              ',
     &   '  bi = ',tileBiW(I,J),
     &   ', bj = ',tileBjW(I,J)
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ELSE
         WRITE(msgBuf,'(A)')
     &   '//         WEST: no neighbor'
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ENDIF
C       o East communication details
        IF ( tileNoE(I,J).NE. NULL_TILE ) THEN
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
     &   '//        EAST: ',
     &   'Tile = ',tileNoE(I,J),
     &   ', Process = ',tilePidE(I,J),
     &   ', Comm = ',commName(tileCommModeE(I,J))
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
     &   '//              ',
     &   '  bi = ',tileBiE(I,J),
     &   ', bj = ',tileBjE(I,J)
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ELSE
         WRITE(msgBuf,'(A)')
     &   '//         EAST: no neighbor'
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ENDIF
C       o South communication method
        IF ( tileNoS(I,J).NE. NULL_TILE ) THEN
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
     &   '//       SOUTH: ',
     &   'Tile = ',tileNoS(I,J),
     &   ', Process = ',tilePidS(I,J),
     &   ', Comm = ',commName(tileCommModeS(I,J))
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
     &   '//              ',
     &   '  bi = ',tileBiS(I,J),
     &   ', bj = ',tileBjS(I,J)
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ELSE
         WRITE(msgBuf,'(A)')
     &   '//        SOUTH: no neighbor'
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ENDIF
C       o North communication method
        IF ( tileNoN(I,J).NE. NULL_TILE ) THEN
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6,A,A)')
     &   '//       NORTH: ',
     &   'Tile = ',tileNoN(I,J),
     &   ', Process = ',tilePidN(I,J),
     &   ', Comm = ',commName(tileCommModeN(I,J))
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
         WRITE(msgBuf,'(A,A,I6.6,A,I6.6)')
     &   '//              ',
     &   '  bi = ',tileBiN(I,J),
     &   ', bj = ',tileBjN(I,J)
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ELSE
         WRITE(msgBuf,'(A)')
     &   '//        NORTH: no neighbor'
         CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)
        ENDIF
       ENDDO
      ENDDO
      WRITE(msgBuf,'(A)')  ' '
      CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT, 1)

      RETURN
      END