!
!######
!#     #    ##    #####     ##    #       #       ######  #          #     ####   #    #
!##    #   #  #   #    #   #  #   #       #       #       #          #    #       ##  ##
!######   #    #  #    #  #    #  #       #       #####   #          #     ####   # ## #
!##       ######  #####   ######  #       #       #       #          #         #  #    #
!##       #    #  #   #   #    #  #       #       #       #          #    #    #  #    #
!##       #    #  #    #  #    #  ######  ######  ######  ######     #     ####   #    #

MODULE Parallelism

  ! Deals with parallelism; exports
  !   MPI procedures for
  !       initialization 
  !       normal finalization 
  !       error finalization
  !   MPI process data:
  !       how many processes in MPI computation
  !       which processes is this
  ! Creates one file per process for printouts,
  ! unscrambling outputs. Provides procedures for:
  !       writing messages to output and to the file
  !       writing messages only to the file


  IMPLICIT NONE

  PRIVATE

  ! public data
  INTEGER,          PUBLIC :: myId =0         ! MPI process rank
  INTEGER,          PUBLIC :: unitDump=30      ! this process dumping file unit
  INTEGER,          PUBLIC :: maxNodes=1
  ! private data

  INTEGER, PARAMETER :: stdout=6

  ! public procedures
  
  PUBLIC :: FatalError
  PUBLIC :: MsgOne
  PUBLIC :: MsgDump
  PUBLIC :: MsgOut


  !INCLUDE 'mpif.h'

CONTAINS 


  !*** Dump message at stdout and dump file ***

  SUBROUTINE Msg(unit, h, message)
    INTEGER        , INTENT(IN) :: unit
    CHARACTER(LEN=*), INTENT(IN) :: h
    CHARACTER(LEN=*), INTENT(IN) :: message
    
    INTEGER                           :: thisThread
    INTEGER, PARAMETER                  :: maxLineLen=128!stdout record size
    CHARACTER(LEN=LEN(h)+LEN(message)) :: fullMsg!full message
    INTEGER                           :: fullMsgLen
    INTEGER                           :: lineCount
    INTEGER                           :: lines
    INTEGER                           :: first
    INTEGER                           :: last

!$  INTEGER, EXTERNAL :: OMP_GET_THREAD_NUM
    thisThread = 0
!$  thisThread = OMP_GET_THREAD_NUM()
    IF (thisThread == 0) then
       fullMsg=TRIM(h)//TRIM(message)
       fullMsgLen=len_Trim(fullMsg)
       lineCount=FullMsgLen/maxLineLen
       IF(lineCount*maxLineLen < fullMsgLen)THEN
          lineCount=lineCount +1
       END IF
       DO lines=1,lineCount
          first=(lines-1)*maxLineLen+1
          last =Min(lines*MaxLineLen,FullMsgLen)
          WRITE(unit,"(a)") fullMsg(first:last)
!$        CALL FLUSH(unit)       
       END DO
    END IF
  END SUBROUTINE Msg




  !*** Dump message at stdout and dump file ***



  SUBROUTINE MsgOut(h, message)
    CHARACTER(LEN=*), INTENT(IN) :: h, message
    CALL Msg(stdout, h, message)
  END SUBROUTINE MsgOut





  !*** Dump message at stdout and dump file ***





  SUBROUTINE MsgOne(h, message)
    CHARACTER(LEN=*), INTENT(IN) :: h
    CHARACTER(LEN=*), INTENT(IN) :: message
    IF (myId == 0) THEN
       CALL Msg(stdout, h, message)
    END IF
  END SUBROUTINE MsgOne




  !*** Dump messsage only at dump file ***



  SUBROUTINE MsgDump(h, message)
    CHARACTER(LEN=*), INTENT(IN) :: h, message
    CALL Msg(unitDump, h, message)
  END SUBROUTINE MsgDump





  !*** Dump error message everywhere and destroy parallelism ***



  SUBROUTINE FatalError(message)
    CHARACTER(LEN=*), INTENT(IN) :: message
    INTEGER :: ierror=-1
    INTEGER :: ierr=0
    CHARACTER(LEN=10) :: h="**(ERROR)**"
    CALL MsgOut(h, message)
    CALL MsgDump(h, message)
    !CALL MPI_ABORT(MPI_COMM_WORLD, ierror, ierr)
    STOP
  END SUBROUTINE FatalError



END MODULE Parallelism