
!!!!!!!!!!!!!!!
! module MPH1 !
!!!!!!!!!!!!!!!

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

      module MPH_Multi_Exec
      implicit none
      include 'mpif.h'

      integer istatus(MPI_STATUS_SIZE), ierr 
      integer max_num_comps, maxProcs_comp
      parameter (max_num_comps=20)     ! maximum number of components
      parameter (maxProcs_comp=128)   ! maximum number of procs per components

      type Acomponent
         character*16 name          ! component name
         integer num_process        ! number of processors 
         integer process_list(maxProcs_comp) 
                                    ! global processor_id, increasing order
      end type Acomponent           
          
      type (Acomponent)  components(max_num_comps) ! allocate components
      integer MPI_Acomponent

      integer icomp, icomp2    ! category to create sub communicators
      integer key              ! order in same communicator
      integer myWorld          ! communicator for this component
      integer myProc           ! my rank in this component
      integer totProcs         ! total processor for this component
      integer myProc_global    ! my rank in the whole world
      integer totProcs_global  ! total processor for the whole world

      integer COMM_master    ! communicator for submaster of each component
    
      character*16 myName
      character*16 component_names(max_num_comps)
      integer total_components 
 
      contains

!--------------- subroutine MPH_setup (comp_name, comm_world) ---------

      subroutine MPH_setup_ME (comp_name, comm_world)
      
      character*(*) comp_name
      integer comm_world

      myName = comp_name
      call MPH_init ()
      call MPH_local ()
      call MPH_global ()
      call MPI_COMM_DUP (myWorld, comm_world, ierr)

      end subroutine MPH_setup_ME


!--------------- subroutine MPH_init () ------------
	
      subroutine MPH_init ()

      integer iblock(3), idisp(3), itype(3)
      call MPI_COMM_RANK (MPI_COMM_WORLD, myProc_global, ierr)
      call MPI_COMM_SIZE (MPI_COMM_WORLD, totProcs_global, ierr)

      total_components = read_list("components.in", "COMPONENT_LIST",  
     &                             component_names, max_num_comps)

! create a new MPI data type MPI_Acomponent

      iblock(1) = 16
      iblock(2) = 1
      iblock(3) = maxProcs_comp
      idisp(1) = 0
      idisp(2) = 16
      idisp(3) = 20
      itype(1) = MPI_CHARACTER
      itype(2) = MPI_INTEGER
      itype(3) = MPI_INTEGER
      call MPI_TYPE_STRUCT (3,iblock,idisp,itype,MPI_Acomponent,ierr)
      call MPI_TYPE_COMMIT (MPI_Acomponent, ierr)

      end subroutine MPH_init


!--------------- subroutine MPH_local () ------------

! local hand-shaking

      subroutine MPH_local ()

      icomp = find_name (myName, component_names, total_components)
      key = 0
      call MPI_COMM_SPLIT (MPI_COMM_WORLD, icomp, key, myWorld, ierr)

! setup myWorld, myProc, totProcs
      call MPI_COMM_RANK (myWorld, myProc, ierr)
      call MPI_COMM_SIZE (myWorld, totProcs, ierr)

      components(icomp)%name = myName
      components(icomp)%num_process = totProcs

! gather processor ids to 0th proc in this component.
      call MPI_GATHER (myProc_global, 1, MPI_INTEGER,  
     &                 components(icomp)%process_list, 1, MPI_INTEGER,  
     &                 0, myWorld, ierr)

! broadcast the process_list to all process in this component
! so that every processor has the complete component structure
!      call MPI_BCAST (components(icomp)%process_list, totProcs, 
!     &                MPI_INTEGER, 0, myWorld, ierr)

      end subroutine MPH_local 


!--------------- subroutine MPH_global () ------------

! global hand-shaking among root processors of each component.

      subroutine MPH_global ()
      integer sendtag, recvtag, i

! create a MPI communicator COMM_master for all submasters
! arrange the rank of the submasters in COMM_master by their icomp
! i.e., their rank of the component model in "components.in" 
      if (myProc == 0) then
         icomp2 = 1
      else
         icomp2 = 2
      endif
      key = icomp
      call MPI_COMM_SPLIT (MPI_COMM_WORLD,icomp2,key,COMM_master,ierr)

! gather Acomponents to 0th proc in COMM_master
      if (myProc == 0) then
         call MPI_GATHER (components(icomp), 1, MPI_Acomponent,
     &                    components, 1, MPI_Acomponent,
     &                    0, COMM_master, ierr)

! 0th proc in COMM_master broadcast Acomponents to all submasters
         call MPI_BCAST (components, total_components,
     &                   MPI_Acomponent, 0, COMM_master, ierr)
      endif

! submaster broadcast AComponents to all process in the components
      call MPI_BCAST (components, total_components,
     &                MPI_Acomponent, 0, myWorld, ierr)

! everybody lists the complete info
      write(*,*)'I am proc ', myProc, ' in ', myName, 
     &          ' , which is proc ', myProc_global, ' in global_world' 
      write(*,*)'infos I have for all proc of all components are:'
      do i = 1, total_components
         write(*,*)'   ', components(i)%name
         write(*,*)'   ', components(i)%num_process
         write(*,*)'   ', components(i)%process_list(1:8)  ! partial list
      enddo

      end subroutine MPH_global


!--- function MPH_global_id (comp_name, local_id) -----

      integer function MPH_global_id (comp_name, local_id)

      character*(*) comp_name
      integer local_id, temp

! then find out the component rank
      temp = find_name (comp_name, component_names, total_components)

! process_list starts from 1, while proc rank starts from 0
      MPH_global_id = components(temp) % process_list(local_id+1)

      end function MPH_global_id


! -------subroutine comm_join (comp_name1, comp_name2, comm_joined) ---

      subroutine comm_join (comp_name1, comp_name2, comm_joined)

      character*(*) comp_name1, comp_name2
      integer temp1, temp2
      integer comm_joined

      temp1 = find_name (comp_name1, component_names, total_components)
      temp2 = find_name (comp_name2, component_names, total_components)

! the order of two components does matter: first one has lower ranks in 
! the new joined communicator, and second one has higher ranks.

      if (icomp == temp1 .or. icomp == temp2) then
         icomp2 = 1
         if (icomp == temp1) then
            key = myProc
         else
            key = totProcs_global + myProc
         endif
      else
         icomp2 = 2
         key = 0
      endif

      call MPI_COMM_SPLIT (MPI_COMM_WORLD,icomp2,key,comm_joined,ierr)

      end subroutine comm_join


!---------- subroutine MPH_redirect_output (name) ---------

      subroutine MPH_redirect_output (name)
      character*(*) name
      integer lenname, lenval, rcode
      character*16 output_name_env
      character*64 output_name, temp_value

      output_name = ' '
      output_name_env = trim (name) // "_out_env"

#if (defined AIX)
      call getenv (trim(output_name_env), temp_value)
      output_name = trim (temp_value)
      if (len_trim(output_name) == 0) then
         write(*,*)'output file names not preset by env varibales'
         write(*,*)'so output not redirected'
      else
         open (unit=6, file=output_name, position='append')
         call flush_(6)
      endif
#endif

#if (defined IRIX64 || defined CRAY || defined sn6711)
      lenname = len_trim (output_name_env)
      call pxfgetenv (output_name_env,lenname,output_name,lenval,rcode)
      if (len_trim(output_name) == 0) then
         write(*,*)'output file names not preset by env varibales'
         write(*,*)'so output not redirected'
      else
         open (unit=6, file=output_name, position='append')
         call flush(6)
      endif
#endif

#if (!defined AIX && !defined IRIX64 && !defined CRAY && !defined sn6711)
      write(*,*) 'No implementation for this architecture'
      write(*,*) 'output redirect is not performed by getenv'
#endif

      end subroutine MPH_redirect_output


! --------------- function read_list(filename, namelist, num) ------------

      integer function read_list (filename, filetag, namelist, num)
      integer i, num
      character*(*) filename, filetag
      character*16 namelist(num), firstline, temp

      open(10, file=filename, status='unknown')
      read(10, '(a16)', end=200) firstline
      if (firstline .ne. filetag) then
         print *, 'ERROR: filetag inconsistent', filename
         print *, 'ERROR: ', filetag, '!=', firstline
         stop
      endif

      read(10, '(a16)', end=200) temp
      if (temp .ne. 'BEGIN') then
         print *, 'ERROR: no BEGIN in ', filename
         stop
      endif

      do i = 1, num
         read(10, '(a16)', end=100) temp
         if (temp .ne. 'END') then
             namelist(i) = temp
         else
             goto 200
         endif
      enddo

100   print *, 'ERROR: no END in ', filename
      stop

200   read_list = i - 1

      return
      end function read_list

      
!---------- function find_name(name, namelist, num) ------------

      integer function find_name(name, namelist, num)

! find name in component_names
      character*(*) name
      integer i, num
      character*16 namelist(num)

      do i = 1, num
         if (name == namelist(i)) then
!            print *, i, name, namelist(i)
            goto 100
         endif
      enddo

! name is not found
      find_name = -1
      print *, "ERROR: ", name, " not found in components.in"
      stop

100   find_name = i
      return
      end function find_name 


! -------subroutine MPH_help (arg) ---

      subroutine MPH_help (arg)
      character*(*) arg
      write(*,*)'Message from MPH_help:'
      if (arg .eq. 'off') then
         write(*,*)'off'
         return
      else if (arg .eq. 'on') then
         write(*,*)'Multiple executables'
         write(*,*)'Required setup function for pop is: '
         write(*,*)'   call MPH_setup ("ocean", POP_World)'
         write(*,*)'Required input file is "components.in"'
      else
         write(*,*)'wrong argument for MPH_help'
      endif
      end subroutine MPH_help

      end module MPH_Multi_Exec


!!!!!!!!!!!!!!!
! module MPH2 !
!!!!!!!!!!!!!!!

! Multi-Process Handshaking utility
! to facilitate a plug & play style programming using single executable.
! each processor only execute one component model once.
! Written by Yun (Helen) He and Chris Ding, NERSC/LBNL, October 2000.


      module MPH_Single_Exec
      implicit none
      include 'mpif.h'

      public
      integer istatus(MPI_STATUS_SIZE), ierr 
      integer max_num_comps, maxProcs_comp
      parameter (max_num_comps=20)     ! maximum number of components
      parameter (maxProcs_comp=128)    ! maximum number of procs per comp

      type Acomponent
         character*16 name          ! component name
         integer num_process        ! number of processors 
         integer process_list(maxProcs_comp) 
                                    ! global processor_id, increasing order
      end type Acomponent          
          
      type (Acomponent)  components(max_num_comps) ! allocate components
      integer MPI_Acomponent

      integer component_id       ! category to create sub communicators
      integer key                ! order in same communicator
      integer local_world        ! communicator for this component
      integer local_proc_id      ! proc id in this component
      integer local_totProcs     ! total processor for this component
      integer global_proc_id     ! proc id in the whole world
      integer global_totProcs    ! total processor for the whole world
      integer COMM_master    ! communicator for submaster of each component
      integer total_components 
      character*16 component_names(max_num_comps)
      integer low_proc_limit(max_num_comps)
      integer up_proc_limit(max_num_comps)
   
      private MPI_Acomponent, components, component_id, key
      private local_world, local_proc_id, global_proc_id
      private local_totProcs, global_totProcs, COMM_master
      private total_components, component_names
      private low_proc_limit, up_proc_limit

      contains 


!---- subroutine MPH_setup_SE (atmosphere, ocean, coupler, land) ------

      subroutine MPH_setup_SE (atmosphere, ocean, coupler, land,
     &           ice, biosphere, io)

      optional atmosphere, ocean, coupler, land, ice, biosphere, io
      external atmosphere, ocean, coupler, land, ice, biosphere, io
      integer id

      call MPH_init ()

      if (present(atmosphere)) then
         id=MPH_find_name("atmosphere",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call atmosphere (local_world)
         endif
      endif

      if (present(ocean)) then
         id=MPH_find_name("ocean",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call ocean (local_world)
         endif
      endif

      if (present(coupler)) then
         id=MPH_find_name("coupler",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call coupler (local_world)
         endif
      endif

! add more component models as follows: 
      if (present(land)) then
         id=MPH_find_name("land",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call land (local_world)
         endif
      endif

      if (present(ice)) then
         id=MPH_find_name("ice",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call ice (local_world)
         endif
      endif

      if (present(biosphere)) then
         id=MPH_find_name("biosphere",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call biosphere (local_world)
         endif
      endif

      if (present(io)) then
         id=MPH_find_name("io",component_names,total_components)
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            call MPH_local (id)
            call MPH_global ()
            call io (local_world)
         endif
      endif

      call MPI_FINALIZE (ierr)

      end subroutine MPH_setup_SE


!--------------- subroutine MPH_init () ------------
	
      subroutine MPH_init ()

      integer iblock(3), idisp(3), itype(3)

      call MPI_INIT (ierr)
      call MPI_COMM_RANK (MPI_COMM_WORLD, global_proc_id, ierr)
      call MPI_COMM_SIZE (MPI_COMM_WORLD, global_totProcs, ierr)

      total_components = MPH_read_list("processors_map.in",
     &              "PROCESSORS_MAP", component_names,  
     &              low_proc_limit, up_proc_limit, max_num_comps)

! create a new MPI data type MPI_Acomponent

      iblock(1) = 16
      iblock(2) = 1
      iblock(3) = maxProcs_comp
      idisp(1) = 0
      idisp(2) = 16
      idisp(3) = 20
      itype(1) = MPI_CHARACTER
      itype(2) = MPI_INTEGER
      itype(3) = MPI_INTEGER
      call MPI_TYPE_STRUCT(3,iblock,idisp,itype,MPI_Acomponent,ierr)
      call MPI_TYPE_COMMIT (MPI_Acomponent, ierr)

      end subroutine MPH_init


!--------------- subroutine MPH_local (id) ------------

! local hand-shaking

      subroutine MPH_local (id)
      integer id

      component_id = id
      key = 0
      call MPI_COMM_SPLIT (MPI_COMM_WORLD, component_id,
     &                     key, local_World, ierr)

! setup local_world, local_proc_id, local_totProcs
      call MPI_COMM_RANK (local_world, local_proc_id, ierr)
      call MPI_COMM_SIZE (local_world, local_totProcs, ierr)

      components(component_id)%name = component_names(component_id)
      components(component_id)%num_process = local_totProcs

! gather processor ids to 0th proc in this component.
      call MPI_GATHER (global_proc_id, 1, MPI_INTEGER, 
     &                 components(component_id)%process_list, 1,
     &                 MPI_INTEGER, 0, local_world, ierr)

      end subroutine MPH_local 


!--------------- subroutine MPH_global () ------------

! global hand-shaking among root processors of each component.

      subroutine MPH_global ()
      integer sendtag, recvtag, i, color

! create a MPI communicator COMM_master for all submasters
! arrange the rank of the submasters in COMM_master by their component_id
! i.e., their rank of the component model in "processors_map.in" 
      if (local_proc_id == 0) then
         color = 1
      else
         color = 2
      endif
      key = component_id
      call MPI_COMM_SPLIT (MPI_COMM_WORLD,color,key,COMM_master,ierr)

! gather Acomponents to 0th proc in COMM_master
      if (local_proc_id == 0) then
         call MPI_GATHER (components(component_id), 1, MPI_Acomponent,
     &        components, 1, MPI_Acomponent, 0, COMM_master, ierr)

! 0th proc in COMM_master broadcast Acomponents to all submasters
         call MPI_BCAST (components, total_components, MPI_Acomponent,
     &                   0, COMM_master, ierr)
      endif

! submaster broadcast AComponents to all process in the components
      call MPI_BCAST (components, total_components,
     &                MPI_Acomponent, 0, local_world, ierr)

! everybody lists the complete info
      write(*,*)'I am proc ', local_proc_id, ' in ',
     &           component_names(component_id), ' , which is proc ',
     &           global_proc_id, ' in global_world' 
      write(*,*)'infos I have for all proc of all components are:'
      do i = 1, total_components
         write(*,*)'   ', components(i)%name
         write(*,*)'   ', components(i)%num_process
         write(*,*)'   ', components(i)%process_list(1:8)  ! partial list
      enddo

      end subroutine MPH_global


!--- function MPH_global_id (name, local_id) -----

      integer function MPH_global_id (name, local_id)

      character*(*) name
      integer local_id, temp

! then find out the component rank
      temp = MPH_find_name (name,component_names,total_components)

! process_list starts from 1, while proc rank starts from 0
      MPH_global_id = components(temp) % process_list(local_id+1)

      end function MPH_global_id


! -------subroutine MPH_comm_join (name1, name2, comm_joined) ---

      subroutine MPH_comm_join (name1, name2, comm_joined)

      character*(*) name1, name2
      integer temp1, temp2
      integer comm_joined, color

      temp1 = MPH_find_name(name1,component_names,total_components)
      temp2 = MPH_find_name(name2,component_names,total_components)

! the order of two components does matter: first one has lower ranks in 
! the new joined communicator, and second one has higher ranks.

      if (component_id==temp1 .or. component_id==temp2) then
         color = 1
         if (component_id == temp1) then
            key = local_proc_id
         else
            key = global_totProcs + local_proc_id
         endif
      else
         color = 2
         key = 0
      endif

      call MPI_COMM_SPLIT (MPI_COMM_WORLD,color,key,comm_joined,ierr)

      end subroutine MPH_comm_join


! -------subroutine MPH_redirect_output (comp_name) ---

      subroutine MPH_redirect_output (comp_name)
      character*(*) comp_name
      character*16 output_name_env
      character*64 output_name, temp_value

      output_name = ' '
      output_name_env = trim (comp_name) // "_out_env"

      call getenv (trim(output_name_env), temp_value)
      output_name = trim (temp_value)

      open (unit=6, file=output_name, position='append')
!      write(*,*)'unit 6 connected to ', output_name
      call flush_(6)

      end subroutine MPH_redirect_output


! --- function MPH_read_list (filename, filetag, namelist, low, up, num) ---

      integer function MPH_read_list (filename, filetag, namelist, 
     &                            low, up, num)
      integer i, num
      character*(*) filename, filetag
      character*16 namelist(num), firstline, temp
      integer itemp1, itemp2
      integer low(num), up(num)

      open(10, file=filename, status='unknown')
      read(10, *, end=100) firstline
      if (firstline .ne. filetag) then
         print *, 'ERROR: filetag inconsistent', filename
         print *, 'ERROR: ', filetag, '!=', firstline
         stop
      endif

      read(10, *, end=200) temp
      if (temp .ne. "BEGIN") then
         print *, 'ERROR: no BEGIN in ', filename
         stop
      endif

      do i = 1, num
         read(10, *, err=300, end=400) temp, itemp1, itemp2
         if (temp .eq. "END") goto 500
         namelist(i) = temp
         low(i) = itemp1
         up(i) = itemp2
      enddo

100   print *, 'ERROR: no filetag in ', filename
      stop

200   print *, 'ERROR: no BEGIN in ', filename
      stop

300   if (temp .eq. "END") then
         goto 500
      else
         print *, 'ERROR: either: no END in ', filename
         print *, '       or: does not provide correct format as'
         print *, '           in input example: ocean 11 18'
         stop
      endif

400   print *, 'ERROR: no END in ', filename
      stop

500   MPH_read_list = i - 1

      return
      end function MPH_read_list

      
!---------- function MPH_find_name(name, namelist, num) ------------

      integer function MPH_find_name(name, namelist, num)

! find name in component_names
      character*(*) name
      integer i, num
      character*16 namelist(num)

      do i = 1, num
         if (name == namelist(i)) then
!            print *, i, name, namelist(i)
            goto 100
         endif
      enddo

! name is not found
      MPH_find_name = -1
      print *, "ERROR: ", name, " not found in processors_map.in"
      stop

100   MPH_find_name = i
      return
      end function MPH_find_name 


! -------subroutine MPH_help (arg) ---

      subroutine MPH_help (arg)
      character*(*) arg
      write(*,*)'Message from MPH_help:'
      if (arg .eq. 'off') then
         write(*,*)'off'
         return
      else if (arg .eq. 'on') then
         write(*,*)'Single executable, processors non-overlap'
         write(*,*)'Required setup function is: '
         write(*,*)'   call MPH_setup_SE (atmosphere=ccm3_8,
     & ocean=pop2_2, coupler=cpl5_1)'
         write(*,*)'Required input file is "processors_map.in"'
      else
         write(*,*)'wrong argument for MPH_help'
      endif

      end subroutine MPH_help


! ---- some inquiry functions----------------------------------------------

      character*16 function MPH_myName()
         MPH_myName = component_names (component_id)
      end function MPH_myName

      integer function MPH_component_id()
         MPH_component_id = component_id
      end function MPH_component_id

      character*16 function MPH_component_name(id)
         integer id
         MPH_component_name = component_names (id)
      end function  MPH_component_name

      integer function MPH_total_components()
         MPH_total_components = total_components
      end function MPH_total_components

      integer function MPH_local_proc_id()
         MPH_local_proc_id = local_proc_id
      end function MPH_local_proc_id

      integer function MPH_global_proc_id()
         MPH_global_proc_id = global_proc_id
      end function MPH_global_proc_id

      integer function MPH_local_world()
         MPH_local_world = local_world
      end function MPH_local_world

      integer function MPH_low_proc_limit(id)
         integer id
         MPH_low_proc_limit = low_proc_limit(id)
      end function MPH_low_proc_limit

      integer function MPH_up_proc_limit(id)
         integer id
         MPH_up_proc_limit = up_proc_limit(id)
      end function MPH_up_proc_limit

      end module MPH_Single_Exec



!!!!!!!!!!!!!!!
! module MPH3 !
!!!!!!!!!!!!!!!

! Multi-Process Handshaking utility
! to facilitate a plug & play style programming using single executable.
! each processor could execute more than one component model (processor
! overlap) in any flexible way (any order).
! Written by Yun (Helen) He and Chris Ding, NERSC/LBNL, December 2000.


      module MPH_Single_Exec_Overlap
      implicit none
      include 'mpif.h'

      public
      integer istatus(MPI_STATUS_SIZE), ierr 
      integer max_num_comps, maxProcs_comp
      parameter (max_num_comps=20)     ! maximum number of components
      parameter (maxProcs_comp=128)    ! maximum number of procs per comp

      type Acomponent
         character*16 name          ! component name
         integer num_process        ! number of processors 
         integer process_list(maxProcs_comp) 
                                    ! global processor_id, increasing order
      end type Acomponent          
          
      type (Acomponent) components(max_num_comps) ! allocate components
      integer MPI_Acomponent

      integer local_world(max_num_comps) ! communicator for each component
      integer local_proc_id(max_num_comps) ! proc id in each component
      integer local_totProcs(max_num_comps) ! total processor for each component
      integer global_proc_id     ! proc id in the whole world
      integer global_totProcs    ! total processor for the whole world
      integer COMM_master    ! communicator for submaster of each component
      integer total_components 
      character*16 component_names(max_num_comps)
      integer low_proc_limit(max_num_comps)
      integer up_proc_limit(max_num_comps)
   
      private MPI_Acomponent, components
      private local_world, local_proc_id, global_proc_id
      private local_totProcs, global_totProcs, COMM_master
      private total_components, component_names
      private low_proc_limit, up_proc_limit

      contains 


!---- subroutine MPH_setup_SE_overlap (model1, model2, ...) ------

      subroutine MPH_setup_SE_overlap (model1, model2, model3, model4,
     &           model5, model6, model7, model8, model9, model10)

      character*(*) model1, model2, model3, model4, model5
      character*(*) model6, model7, model8, model9, model10
      optional model1, model2, model3, model4, model5
      optional model6, model7, model8, model9, model10

      integer id, i

      call MPH_init ()
      call MPH_local ()
      call MPH_global ()

      end subroutine MPH_setup_SE_overlap


!--------------- subroutine MPH_init () ------------
	
      subroutine MPH_init ()

      integer iblock(3), idisp(3), itype(3)

      call MPI_INIT (ierr)
      call MPI_COMM_RANK (MPI_COMM_WORLD, global_proc_id, ierr)
      call MPI_COMM_SIZE (MPI_COMM_WORLD, global_totProcs, ierr)

      total_components = MPH_read_list("processors_map.in",
     &              "PROCESSORS_MAP", component_names,   
     &              low_proc_limit, up_proc_limit, max_num_comps,
     &              local_totProcs)

! create a new MPI data type MPI_Acomponent

      iblock(1) = 16
      iblock(2) = 1
      iblock(3) = maxProcs_comp
      idisp(1) = 0
      idisp(2) = 16
      idisp(3) = 20
      itype(1) = MPI_CHARACTER
      itype(2) = MPI_INTEGER
      itype(3) = MPI_INTEGER
      call MPI_TYPE_STRUCT(3,iblock,idisp,itype,MPI_Acomponent,ierr)
      call MPI_TYPE_COMMIT (MPI_Acomponent, ierr)

      end subroutine MPH_init


!--------------- subroutine MPH_local () ------------

      subroutine MPH_local ()
      integer id, i, color, key

! setup local_world, local_proc_id, local_totProcs
      do id = 1, total_components
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            color = 1
         else
            color = 2
         endif
         key = 0
         call MPI_COMM_SPLIT (MPI_COMM_WORLD, color, key,
     &                        local_World(id), ierr)
         call MPI_COMM_RANK(local_world(id),local_proc_id(id),ierr)
      enddo

      end subroutine MPH_local 


!--------------- subroutine MPH_global () ------------

      subroutine MPH_global ()
      integer id, i

! record Acomponent for each component
      do id = 1, total_components
         components(id)%name = component_names(id)
         components(id)%num_process = local_totProcs(id)
         do i = low_proc_limit(id), up_proc_limit(id)
            components(id)%process_list(i-low_proc_limit(id)+1)=i
         enddo
      enddo

! everybody lists the complete info
      do id = 1, total_components
         if (low_proc_limit(id) .le. global_proc_id .and.
     &       global_proc_id .le. up_proc_limit(id)) then
            write(*,*)'I am proc ', local_proc_id(id), ' in ',
     &           component_names(id), ' , which is proc ',
     &           global_proc_id, ' in global_world' 
            write(*,*)'infos I have for all proc of all components are:'
            do i = 1, total_components
               write(*,*)'   ', components(i)%name
               write(*,*)'   ', components(i)%num_process
               write(*,*)'   ', components(i)%process_list(1:9)
            enddo
         endif
      enddo

      end subroutine MPH_global


!--- function PE_in_component (name, comm) -----

      logical function PE_in_component (name, comm)
      character*(*) name
      integer id, comm

      id = MPH_find_name(name, component_names, total_components)
      if (low_proc_limit(id) .le. global_proc_id .and.
     &    global_proc_id .le. up_proc_limit(id)) then
         comm = local_world(id)
         PE_in_component = .true.
      else
         PE_in_component = .false.
      endif

      end function PE_in_component 


!--- function MPH_global_id (name, local_id) -----

      integer function MPH_global_id (name, local_id)

      character*(*) name
      integer local_id, temp

! then find out the component rank
      temp = MPH_find_name (name,component_names,total_components)

! process_list starts from 1, while proc rank starts from 0
      MPH_global_id = components(temp) % process_list(local_id+1)

      end function MPH_global_id


! -------subroutine MPH_comm_join (name1, name2, comm_joined) ---

      subroutine MPH_comm_join (name1, name2, comm_joined)
      integer id1, id2

      character*(*) name1, name2
      integer comm_joined, color, key
      logical con1, con2

      id1 = MPH_find_name(name1,component_names,total_components)
      id2 = MPH_find_name(name2,component_names,total_components)

! the order of two components does matter: first one has lower ranks in 
! the new joined communicator, and second one has higher ranks.

      con1 = (low_proc_limit(id1) .le. global_proc_id) .and.
     &       (global_proc_id .le. up_proc_limit(id1))
      con2 = (low_proc_limit(id2) .le. global_proc_id).and.
     &       (global_proc_id .le. up_proc_limit(id2))
 
      if (con1 .or. con2) then
         color = 1
         if (con1) then 
            key = local_proc_id(id1)
         else
            key = global_totProcs + local_proc_id(id2)
         endif
      else
         color = 2
         key = 0
      endif

      call MPI_COMM_SPLIT (MPI_COMM_WORLD,color,key,comm_joined,ierr)

      end subroutine MPH_comm_join



! -------subroutine MPH_redirect_output (comp_name) ---

      subroutine MPH_redirect_output (comp_name)
      character*(*) comp_name
      character*16 output_name_env
      character*64 output_name, temp_value

      output_name = ' '
      output_name_env = trim (comp_name) // "_out_env"

      call getenv (trim(output_name_env), temp_value)
      output_name = trim (temp_value)

      open (unit=6, file=output_name, position='append')
!      write(*,*)'unit 6 connected to ', output_name
      call flush_(6)

      end subroutine MPH_redirect_output


! --- function MPH_read_list (filename, filetag, namelist, low, up, num) ---

      integer function MPH_read_list (filename, filetag, namelist,  
     &                            low, up, num, local_num)
      integer i, num
      character*(*) filename, filetag
      character*16 namelist(num), firstline, temp
      integer itemp1, itemp2
      integer low(num), up(num), local_num(num)

      open(10, file=filename, status='unknown')
      read(10, *, end=100) firstline
      if (firstline .ne. filetag) then
         print *, 'ERROR: filetag inconsistent', filename
         print *, 'ERROR: ', filetag, '!=', firstline
         stop
      endif

      read(10, *, end=200) temp
      if (temp .ne. "BEGIN") then
         print *, 'ERROR: no BEGIN in ', filename
         stop
      endif

      do i = 1, num
         read(10, *, err=300, end=400) temp, itemp1, itemp2
         if (temp .eq. "END") goto 500
         namelist(i) = temp
         low(i) = itemp1
         up(i) = itemp2
         local_num(i) = itemp2 - itemp1 + 1
      enddo

100   print *, 'ERROR: no filetag in ', filename
      stop

200   print *, 'ERROR: no BEGIN in ', filename
      stop

300   if (temp .eq. "END") then
         goto 500
      else
         print *, 'ERROR: either: no END in ', filename
         print *, '       or: does not provide correct format as'
         print *, '           in input example: ocean 11 18'
         stop
      endif

400   print *, 'ERROR: no END in ', filename
      stop

500   MPH_read_list = i - 1

      return
      end function MPH_read_list

      
!---------- function MPH_find_name(name, namelist, num) ------------

      integer function MPH_find_name(name, namelist, num)

! find name in component_names
      character*(*) name
      integer i, num
      character*16 namelist(num)

      do i = 1, num
         if (name == namelist(i)) then
!            print *, i, name, namelist(i)
            goto 100
         endif
      enddo

! name is not found
      MPH_find_name = -1
      print *, "ERROR: ", name, " not found in processors_map.in"
      stop

100   MPH_find_name = i
      return
      end function MPH_find_name 


! -------subroutine MPH_help (arg) ---

      subroutine MPH_help (arg)
      character*(*) arg
      write(*,*)'Message from MPH_help:'
      if (arg .eq. 'off') then
         write(*,*)'off'
         return
      else if (arg .eq. 'on') then
         write(*,*)'Single executable, processors overlap'
         write(*,*)'Required setup function is: '
         write(*,*)'   call MPH_setup_SE_overlap ("atmosphere",
     & "ocean", "coupler")'
         write(*,*)'Required input file is "processors_map.in"'
      else
         write(*,*)'wrong argument for MPH_help'
      endif

      end subroutine MPH_help


! ---- some inquiry functions----------------------------------------------

      character*16 function MPH_myName(id)
         integer id
         MPH_myName = component_names (id)
      end function MPH_myName

      character*16 function MPH_component_name(id)
         integer id
         MPH_component_name = component_names (id)
      end function  MPH_component_name

      integer function MPH_total_components()
         MPH_total_components = total_components
      end function MPH_total_components

      integer function MPH_local_proc_id(id)
         integer id
         MPH_local_proc_id = local_proc_id(id)
      end function MPH_local_proc_id

      integer function MPH_global_proc_id()
         MPH_global_proc_id = global_proc_id
      end function MPH_global_proc_id

      integer function MPH_local_world(id)
         integer id
         MPH_local_world = local_world(id)
      end function MPH_local_world

      integer function MPH_low_proc_limit(id)
         integer id
         MPH_low_proc_limit = low_proc_limit(id)
      end function MPH_low_proc_limit

      integer function MPH_up_proc_limit(id)
         integer id
         MPH_up_proc_limit = up_proc_limit(id)
      end function MPH_up_proc_limit

      end module MPH_Single_Exec_Overlap

