
! A driver ocean model code for Multi-Process Handshaking utility
! to facilitate a plug & play style programming on
! using multiple component executables.
! Written by Yun (Helen) He and Chris Ding, NERSC/LBNL.


      program main

#ifdef MPH
      use MPH_comm
      implicit none
      integer Global_World, COMM_cpl_pop
      integer global_sum1, global_sum2
      integer myProc_joined, join_sum
      character*10 c2o(30)
#else
      implicit none
      include 'mpif.h'
      integer ierr, myProc
#endif

      integer POP_World
      integer local_sum

      call MPI_INIT (ierr)
#ifdef MPH
      call MPH_setup ("ocean", POP_World)
      call MPI_COMM_DUP (MPI_COMM_WORLD, Global_World, ierr)
      write(*,*) myProc, ' in pop === ', myProc_global, ' in global'
#else
!--- Stand-alone mode.
      call MPI_COMM_DUP( MPI_COMM_WORLD, POP_World, ierr)
      call MPI_COMM_RANK (POP_World, myProc, ierr)
#endif

!------ Do MPI operations as if no other components are involved -------

      call MPI_REDUCE (myProc, local_sum, 1, MPI_INTEGER, MPI_SUM,
     &                 0, POP_World, ierr)
      if (myProc == 0) then
         write(*,*)' sum of local ranks in pop is ', local_sum
      endif

#ifdef MPH

!--- Some additional tests with MPH

      call MPI_REDUCE (myProc_global, global_sum1, 1, MPI_INTEGER,
     &                 MPI_SUM, 0, POP_World, ierr)
      call MPI_ALLREDUCE (myProc_global, global_sum2, 1, MPI_INTEGER, 
     &                    MPI_SUM, Global_World, ierr)
      if (myProc == 0) then
         write(*,*)' sum of global ranks in pop is ', global_sum1
         write(*,*)' sum of global ranks in world is ', global_sum2
      endif

!--- Recv a message from Proc 0 on coupler as specified in components.in 
!--- Note the use of MPH_global_id() function.

      if (myProc == 5) then
         write(*,*) 'I am pop 5 (g=8), recv from cpl 0 (g=7)'
         call MPI_RECV (c2o, 300, MPI_CHARACTER,
     &                  MPH_global_id("coupler", 0), 3000,
     &                  Global_World, istatus, ierr)
         write(*,*)'I am pop 5, expect c2o=abcdefg'
         write(*,*)'pop 5 gets c2o(1)=', c2o(1)
      endif

!--- to create a joined communicator for "coupler" and "ocean".

      call comm_join ("coupler", "ocean", COMM_cpl_pop)
      call MPI_COMM_RANK (COMM_cpl_pop, myProc_joined, ierr)
      write(*,*)'myProc_joined=', myProc_joined
      call MPI_ALLREDUCE (myProc_joined, join_sum, 1, MPI_INTEGER,
     &                    MPI_SUM, COMM_cpl_pop, ierr)
      if (myProc == 0) then 
         write(*,*)' sum of joined ranks in cpl_pop is ', join_sum
      endif

#endif

      write(*,*)
      call MPI_FINALIZE (ierr)
      end
