!    Copyright (c) 2009-2012 by High Performance Computing Virtual Laboratory
!
!    This is test example 3 of square root summation
!    for the DMSM library.
!
!    In this test, there are three input data
!    files. One is
!    TotalNumberOfOpenMPThreadsPerProcess
!    which containes only one integer as it names.
!
!    Another input data file is in.dat, which
!    containes two lines of integers as follows.
!
!    The first line is the JOB_DISTRIBUTION_PLAN
!    which can only take 11, 12, 13, 21, 22, 23,
!    31, 32, or 33.
!
!    The second line is the total number of jobs,
!    and number of jobs in each job group.
!
!    The last file is integers.dat, which is
!    the upper bound for square root summation.
!
!    The comment lines of the file dmsm.f90 is
!    a little more detailed description of the
!    DMSM model and its examples.


MODULE  MY_DATA
  USE                     OMP_LIB
  INCLUDE                 'mpif.h'
  INTEGER              :: MY_MPI_RANK, TOTAL_MPI_PROCESSES, IERR
  INTEGER              :: THREADS_PER_PROCESS_EXPECTED=0
  INTEGER              :: JOB_DISTRIBUTION_PLAN
  INTEGER              :: TOTAL_JOBS, NUM_OF_JOBS_PER_GROUP
  INTEGER, ALLOCATABLE :: INITIAL_DATA_FOR_JOBS(:)
  INTEGER, ALLOCATABLE :: INITIAL_DATA_FOR_A_JOB_GROUP(:)
  INTEGER              :: FINAL_ELEMENTS_MASTER=0
  DOUBLE PRECISION, ALLOCATABLE :: FINAL_RESULT_IN_MASTER(:)
  INTEGER, ALLOCATABLE :: FINAL_RESULT_IN_MASTER_IN(:,:)
  INTEGER              :: FINAL_ELEMENTS_THREAD=0
  DOUBLE PRECISION, ALLOCATABLE :: FINAL_RESULT_IN_THREAD(:)
  INTEGER, ALLOCATABLE :: FINAL_RESULT_IN_THREAD_IN(:,:)
!$OMP THREADPRIVATE(FINAL_ELEMENTS_THREAD, FINAL_RESULT_IN_THREAD, FINAL_RESULT_IN_THREAD_IN)
END MODULE  MY_DATA


MODULE ALL_MODULES
  USE MY_DATA
  USE DMSM_MODULE
END MODULE  ALL_MODULES




PROGRAM A_DMSM_EXAMPLE
  USE   ALL_MODULES
  INTERFACE
      SUBROUTINE PREPARE_FOR_A_JOB_GROUP(JOB_START,JOB_END,MY_RANK,DESTINATION)
      INTEGER:: JOB_START,JOB_END,MY_RANK,DESTINATION
      END SUBROUTINE PREPARE_FOR_A_JOB_GROUP

      SUBROUTINE COLLECT_SOME_RESULTS(MY_RANK,FROM)
      INTEGER:: MY_RANK,FROM
      END SUBROUTINE COLLECT_SOME_RESULTS

      SUBROUTINE DO_MY_JOB(MY_JOB)
      INTEGER:: MY_JOB
      END SUBROUTINE DO_MY_JOB
  END INTERFACE

  CALL  MPIINIT
  CALL  DATA_INITIALIZE
  CALL  DMSM_ALL(THREADS_PER_PROCESS_EXPECTED,JOB_DISTRIBUTION_PLAN, &
                 TOTAL_JOBS, NUM_OF_JOBS_PER_GROUP,&
                 DO_MY_JOB, PREPARE_FOR_A_JOB_GROUP, COLLECT_SOME_RESULTS, .TRUE.)
  CALL  FINAL_OUTPUT()
  CALL  DATA_FINALIZE
  CALL  MPI_FINALIZE(IERR)
  STOP
END PROGRAM A_DMSM_EXAMPLE




SUBROUTINE MPIINIT
  USE  ALL_MODULES
  CALL MPI_INIT( IERR )
  CALL MPI_COMM_RANK(MPI_COMM_WORLD,MY_MPI_RANK,IERR)
  CALL MPI_COMM_SIZE(MPI_COMM_WORLD,TOTAL_MPI_PROCESSES,IERR)
  RETURN
END SUBROUTINE MPIINIT




SUBROUTINE DATA_INITIALIZE
  USE ALL_MODULES
  IMPLICIT  NONE
  INTEGER   :: I

  IF(MY_MPI_RANK.EQ.DMSM_GET_MASTER()) THEN
     OPEN(11,FILE="TotalNumberOfOpenMPThreadsPerProcess")
     READ(11,*) THREADS_PER_PROCESS_EXPECTED
     CLOSE(11)
     OPEN(11,FILE="in.dat")
     READ(11,*) JOB_DISTRIBUTION_PLAN
     READ(11,*) TOTAL_JOBS, NUM_OF_JOBS_PER_GROUP
     CLOSE(11)
  END IF

  CALL MPI_BCAST(THREADS_PER_PROCESS_EXPECTED, 1,MPI_INTEGER,DMSM_GET_MASTER(),MPI_COMM_WORLD,IERR)
  CALL MPI_BCAST(JOB_DISTRIBUTION_PLAN,        1,MPI_INTEGER,DMSM_GET_MASTER(),MPI_COMM_WORLD,IERR)
  CALL MPI_BCAST(TOTAL_JOBS,                   1,MPI_INTEGER,DMSM_GET_MASTER(),MPI_COMM_WORLD,IERR)
  CALL MPI_BCAST(NUM_OF_JOBS_PER_GROUP,        1,MPI_INTEGER,DMSM_GET_MASTER(),MPI_COMM_WORLD,IERR)

  IF(MY_MPI_RANK.EQ.DMSM_GET_MASTER()) THEN
     ALLOCATE(INITIAL_DATA_FOR_JOBS(TOTAL_JOBS))
	 OPEN(11,FILE="integers.dat")
        DO I=1,TOTAL_JOBS
           READ(11,*) INITIAL_DATA_FOR_JOBS(I)
        END DO
     CLOSE(11)
  END IF

  ALLOCATE(INITIAL_DATA_FOR_A_JOB_GROUP(NUM_OF_JOBS_PER_GROUP))

  CALL OMP_SET_NUM_THREADS(THREADS_PER_PROCESS_EXPECTED)

!$OMP PARALLEL
  ALLOCATE(FINAL_RESULT_IN_THREAD(TOTAL_JOBS))
  ALLOCATE(FINAL_RESULT_IN_THREAD_IN(4,TOTAL_JOBS))
  FINAL_ELEMENTS_THREAD=0
!$OMP END PARALLEL

  IF(MY_MPI_RANK.EQ.DMSM_GET_MASTER()) ALLOCATE(FINAL_RESULT_IN_MASTER(TOTAL_JOBS))
  IF(MY_MPI_RANK.EQ.DMSM_GET_MASTER()) ALLOCATE(FINAL_RESULT_IN_MASTER_IN(4,TOTAL_JOBS))
  FINAL_ELEMENTS_MASTER=0

  RETURN
END SUBROUTINE DATA_INITIALIZE




SUBROUTINE DATA_FINALIZE
  USE ALL_MODULES
  IMPLICIT  NONE
  IF(MY_MPI_RANK.EQ.DMSM_GET_MASTER()) THEN
     IF(ALLOCATED(INITIAL_DATA_FOR_JOBS))     DEALLOCATE(INITIAL_DATA_FOR_JOBS)
  END IF
  IF(ALLOCATED(INITIAL_DATA_FOR_A_JOB_GROUP)) DEALLOCATE(INITIAL_DATA_FOR_A_JOB_GROUP)
  IF(ALLOCATED(FINAL_RESULT_IN_MASTER))       DEALLOCATE(FINAL_RESULT_IN_MASTER)
  IF(ALLOCATED(FINAL_RESULT_IN_MASTER_IN))    DEALLOCATE(FINAL_RESULT_IN_MASTER_IN)
  IF(ALLOCATED(FINAL_RESULT_IN_THREAD))       DEALLOCATE(FINAL_RESULT_IN_THREAD)
  IF(ALLOCATED(FINAL_RESULT_IN_THREAD_IN))    DEALLOCATE(FINAL_RESULT_IN_THREAD_IN)
  RETURN
END SUBROUTINE DATA_FINALIZE




SUBROUTINE DO_MY_JOB(MY_JOB)
  USE ALL_MODULES
  IMPLICIT  NONE
  INTEGER:: MY_JOB,THEINTEGER,I
  DOUBLE PRECISION :: R
  THEINTEGER= INITIAL_DATA_FOR_A_JOB_GROUP(MY_JOB-DMSM_GET_GROUP_START(MY_JOB)+1)
  CALL DMSM_UNSET_AN_INITIAL_LOCK()
  R=0.0D0
  DO I=0,THEINTEGER
     R=R+SQRT(1.0D0*I)
  END DO

  FINAL_ELEMENTS_THREAD=FINAL_ELEMENTS_THREAD+1
  FINAL_RESULT_IN_THREAD_IN(1,FINAL_ELEMENTS_THREAD)=MY_JOB
  FINAL_RESULT_IN_THREAD_IN(2,FINAL_ELEMENTS_THREAD)=THEINTEGER
  FINAL_RESULT_IN_THREAD_IN(3,FINAL_ELEMENTS_THREAD)=MY_MPI_RANK
  FINAL_RESULT_IN_THREAD_IN(4,FINAL_ELEMENTS_THREAD)=OMP_GET_THREAD_NUM()
  FINAL_RESULT_IN_THREAD(FINAL_ELEMENTS_THREAD)=R
  RETURN
END SUBROUTINE DO_MY_JOB




SUBROUTINE PREPARE_FOR_A_JOB_GROUP(JOB_START,JOB_END,MY_RANK,DESTINATION)
   USE ALL_MODULES
   IMPLICIT  NONE
   INTEGER:: MY_RANK,DESTINATION
   INTEGER:: JOB_START, JOB_END, COUNTS, TAG=175
   INTEGER:: MPISTTS(MPI_STATUS_SIZE)

   IF((MY_RANK.NE.DMSM_GET_MASTER()).AND.(MY_RANK.NE.DESTINATION)) THEN
      WRITE(*,*) "ERROR RANKS: ",MY_RANK, ", ", DMSM_GET_MASTER()," AND ",DESTINATION
      STOP
   END IF

   COUNTS=JOB_END-JOB_START+1
   IF(MY_RANK.EQ.DESTINATION) CALL DMSM_WAIT_FOR_INITIAL_LOCKS()

   IF(DESTINATION.EQ.DMSM_GET_MASTER()) THEN
      INITIAL_DATA_FOR_A_JOB_GROUP(1:COUNTS)=INITIAL_DATA_FOR_JOBS(JOB_START:JOB_END)
   ELSE
      IF(MY_RANK.EQ.DMSM_GET_MASTER()) THEN
         CALL MPI_SEND(INITIAL_DATA_FOR_JOBS(JOB_START:),COUNTS,MPI_INTEGER, &
                       DESTINATION,TAG,MPI_COMM_WORLD,IERR)
      ELSE
         CALL MPI_RECV(INITIAL_DATA_FOR_A_JOB_GROUP,  COUNTS,MPI_INTEGER, &
                       DMSM_GET_MASTER(),TAG,MPI_COMM_WORLD,MPISTTS,IERR)
      END IF
   END IF

   RETURN
END SUBROUTINE PREPARE_FOR_A_JOB_GROUP




SUBROUTINE COLLECT_SOME_RESULTS(MY_RANK,FROM)
  USE ALL_MODULES
  IMPLICIT  NONE
  INTEGER:: MY_RANK,FROM
  INTEGER:: L,S,TE,TAG
  INTEGER:: MPISTTS(MPI_STATUS_SIZE)

  IF((MY_RANK.NE.DMSM_GET_MASTER()).AND.(MY_RANK.NE.FROM)) THEN
     WRITE(*,*) "ERROR RANKS: ",MY_RANK, ", ", DMSM_GET_MASTER()," AND ",FROM
     STOP
  END IF

  IF(DMSM_GET_MASTER().EQ.FROM) THEN
     IF(FINAL_ELEMENTS_THREAD.GT.0) THEN
        FINAL_RESULT_IN_MASTER(FINAL_ELEMENTS_MASTER+1:FINAL_ELEMENTS_MASTER+FINAL_ELEMENTS_THREAD)=&
                               FINAL_RESULT_IN_THREAD(1:FINAL_ELEMENTS_THREAD)
        FINAL_RESULT_IN_MASTER_IN(1:4,FINAL_ELEMENTS_MASTER+1:FINAL_ELEMENTS_MASTER+FINAL_ELEMENTS_THREAD)=&
                               FINAL_RESULT_IN_THREAD_IN(1:4,1:FINAL_ELEMENTS_THREAD)
        FINAL_ELEMENTS_MASTER=FINAL_ELEMENTS_MASTER+FINAL_ELEMENTS_THREAD
        FINAL_ELEMENTS_THREAD=0
     END IF

  ELSE
     IF(MY_RANK.EQ.DMSM_GET_MASTER()) THEN
        CALL MPI_RECV(TE,1,MPI_INTEGER,FROM,MPI_ANY_TAG,MPI_COMM_WORLD,MPISTTS,IERR)
        IF(TE.GT.0) THEN
           TAG=MPISTTS(MPI_TAG)
           CALL MPI_RECV(FINAL_RESULT_IN_MASTER(FINAL_ELEMENTS_MASTER+1:FINAL_ELEMENTS_MASTER+TE), &
                         TE,MPI_DOUBLE_PRECISION,FROM,TAG,MPI_COMM_WORLD,MPISTTS,IERR)
           CALL MPI_RECV(FINAL_RESULT_IN_MASTER_IN(1:4,FINAL_ELEMENTS_MASTER+1:FINAL_ELEMENTS_MASTER+TE), &
                         4*TE,MPI_INTEGER,FROM,TAG,MPI_COMM_WORLD,MPISTTS,IERR)
           FINAL_ELEMENTS_MASTER=FINAL_ELEMENTS_MASTER+TE
        END IF

     ELSE
        CALL MPI_SEND(FINAL_ELEMENTS_THREAD,1,MPI_INTEGER,DMSM_GET_MASTER(),DMSM_GET_TAG(),MPI_COMM_WORLD,IERR)
        IF(FINAL_ELEMENTS_THREAD.GT.0) THEN
           CALL MPI_SEND(FINAL_RESULT_IN_THREAD(1:FINAL_ELEMENTS_THREAD),FINAL_ELEMENTS_THREAD,&
                                   MPI_DOUBLE_PRECISION,DMSM_GET_MASTER(),DMSM_GET_TAG(),MPI_COMM_WORLD,IERR)
           CALL MPI_SEND(FINAL_RESULT_IN_THREAD_IN(1:4,1:FINAL_ELEMENTS_THREAD),4*FINAL_ELEMENTS_THREAD,&
                                            MPI_INTEGER,DMSM_GET_MASTER(),DMSM_GET_TAG(),MPI_COMM_WORLD,IERR)
           FINAL_ELEMENTS_THREAD=0
        END IF

     END IF

  END IF

  RETURN
END SUBROUTINE COLLECT_SOME_RESULTS




SUBROUTINE FINAL_OUTPUT()
  USE ALL_MODULES
  IMPLICIT  NONE
  INTEGER:: I,J,K(4)
  DOUBLE PRECISION :: R
  IF (MY_MPI_RANK .EQ. DMSM_GET_MASTER())   THEN
      !OPEN(14,FILE="sqrtrootsumallo.dat")
      !    WRITE(14,*) FINAL_ELEMENTS_MASTER, TOTAL_JOBS
      !    DO I=1, FINAL_ELEMENTS_MASTER
      !       WRITE(14,*) FINAL_RESULT_IN_MASTER_IN(1:4,I)
      !       WRITE(14,*) FINAL_RESULT_IN_MASTER(I)
      !    END DO
      !    WRITE(14,*) "DONE BY EXAMPLE4."
      !CLOSE(14)
      OPEN(14,FILE="sqrtrootsumall.dat")
          WRITE(14,*) FINAL_ELEMENTS_MASTER, TOTAL_JOBS
          DO I=1, FINAL_ELEMENTS_MASTER-1
          DO J=I+1, FINAL_ELEMENTS_MASTER
             IF(FINAL_RESULT_IN_MASTER_IN(1,I).GT.FINAL_RESULT_IN_MASTER_IN(1,J)) THEN
                K=FINAL_RESULT_IN_MASTER_IN(1:4,I)
                FINAL_RESULT_IN_MASTER_IN(1:4,I)=FINAL_RESULT_IN_MASTER_IN(1:4,J)
                FINAL_RESULT_IN_MASTER_IN(1:4,J)=K
                R=FINAL_RESULT_IN_MASTER(I)
                FINAL_RESULT_IN_MASTER(I)=FINAL_RESULT_IN_MASTER(J)
                FINAL_RESULT_IN_MASTER(J)=R
             END IF
          END DO
          END DO
          DO I=1, FINAL_ELEMENTS_MASTER
             WRITE(14,*) I, FINAL_RESULT_IN_MASTER(I)
          END DO
          WRITE(14,*) "DONE BY EXAMPLE3."
      CLOSE(14)
      WRITE(*,*) "DONE BY EXAMPLE3."
  END IF
  RETURN
END SUBROUTINE FINAL_OUTPUT



