
! A driver coupler 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_Multi_Exec
      implicit none
      integer Global_World, COMM_cpl_pop
      integer global_sum1, global_sum2
      integer myProc_joined, join_sum
      integer a2c(100)
      character*10 c2o(30)
#else
      implicit none
      include 'mpif.h'
      integer ierr, myProc
#endif

      integer CPL_World
      integer local_sum

      call MPI_INIT (ierr)
#ifdef MPH
      call MPH_setup_ME ("coupler", CPL_World)
      call MPI_COMM_DUP (MPI_COMM_WORLD, Global_World, ierr)
      if (myProc_global==0) call MPH_help ('on')
      if (myProc==0) call MPH_redirect_output ('cpl')
      write(*,*) myProc, ' in cpl === ', myProc_global, ' in global'
#else
!--- Stand-alone mode.
      call MPI_COMM_DUP( MPI_COMM_WORLD, CPL_World, ierr)
      call MPI_COMM_RANK (CPL_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, CPL_World, ierr)
      if (myProc == 0) then
         write(*,*)' sum of local ranks in cpl is ', local_sum
      endif

#ifdef MPH

!--- Some additional tests with MPH

      call MPI_REDUCE (myProc_global, global_sum1, 1, MPI_INTEGER,
     &                 MPI_SUM, 0, CPL_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 cpl is ', global_sum1
         write(*,*)' sum of global ranks in world is ', global_sum2
      endif

!--- Recv a message from Proc 1 on atmosphere, send a message to 
!--- Proc 5 on ocean as sepecified in components.in 
!--- Note the use of MPH_global_id() function.

      c2o = 'abcdefg'
      if (myProc == 0) then
         write(*,*)'I am cpl 0 (g=7), recv from ccm 1 (g=3)'
         call MPI_RECV (a2c, 100, MPI_INTEGER,
     &                  MPH_global_id ("atmosphere", 1), 1000,
     &                  Global_World, istatus, ierr)
         write(*,*)'I am cpl 0, expect a2c(1)=100'
         write(*,*)'cpl 0 gets a2c(1)=', a2c(1)

         write(*,*)'I am cpl 0 (g=7), send to pop 5 (g=8)'
         call MPI_SEND (c2o, 300, MPI_CHARACTER,
     &                  MPH_global_id ("ocean", 5), 3000,
     &                  Global_World,ierr)
         write(*,*)'cpl 0 sent to pop 5 successfully'
      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
