! A coupler model subroutine for Multi-Process Handshaking utility
! to facilitate a plug & play style programming using single executable.
! Written by Yun (Helen) He and Chris Ding, NERSC/LBNL, October 2000.


      subroutine cpl5_1 (CPL_World)

      use MPH_module
      implicit none

      integer CPL_World, myProc, myProc_global
      integer Global_World, COMM_cpl_pop
      integer local_sum, global_sum1, global_sum2
      integer myProc_joined, join_sum
      integer a2c(100)
      character*10 c2o(30)

      call MPI_COMM_DUP (MPI_COMM_WORLD, Global_World, ierr)

      call MPI_COMM_RANK (MPI_COMM_WORLD, myProc_global, ierr)
      call MPI_COMM_RANK (CPL_World, myProc, ierr)
      write(*,*) myProc, ' in cpl === ', myProc_global, ' in global'
      write(*,*) 'MPH_local_proc_id()=', MPH_local_proc_id() 
      write(*,*) 'MPH_global_proc_id()=', MPH_global_proc_id() 

!------ 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

!--- 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 local proc 1 of atmosphere,
!--- send a message to local proc 5 of ocean  
!--- Note the use of MPH_global_id() function.

      c2o = 'abcdefg'
      if (myProc == 0) then
         write(*,*)'I am cpl 0 (g=8), recv from ccm 1 (g=7)'
         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=8), send to pop 5 (g=5)'
         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 MPH_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

      end subroutine
