c various parallel routines  MPI

      subroutine parallel_init()
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer ierr,icolor,ikey

         call MPI_Init(ierr)
         call MPI_COMM_RANK(MPI_COMM_WORLD,myrank_world,ierr)
         call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc_world,ierr)
         root_world= .false.
         if (myrank_world.eq.0) root_world = .true.
!        group1 = .false.
!        group2 = .false.
!        if (myrank.lt.(nproc/2)) then
!              icolor = 1
!              ikey = myrank
!              group1 = .true.
!        endif
!        if (myrank.ge.(nproc/2)) then
!              icolor = 2
!              ikey = myrank - nproc/2
!              group2 = .true.
!        endif
!        call MPI_COMM_SPLIT(MPI_COMM_WORLD,icolor,ikey,my_comm,ierr)
 
      end 

      subroutine split_comm(skey)    ! create communicators for separate runs
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer ierr,skey
        
         comm_world=MPI_COMM_WORLD
         call MPI_COMM_SPLIT(comm_world,skey,myrank_world,my_comm_local
     .             ,ierr)

 
         call MPI_COMM_RANK(my_comm_local,myrank,ierr)
         call MPI_COMM_SIZE(my_comm_local,nproc,ierr)
         root= .false.
         if (myrank.eq.0) root = .true.

         write(*,*) 'myrank_world,myrank,my_comm_local'
         write(*,*) myrank_world,myrank,my_comm_local

      end

      subroutine parallel_end()
         include 'tas.cm'
         include 'mpif.h'
         integer ierr
         call MPI_Finalize(ierr)
         stop
      end 

c ---------------------------------------------------------
      subroutine bcast_array(a,n,myid)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,myid
         real*8 a(n)
         integer ierr
         call MPI_BCast(a,n,MPI_DOUBLE_PRECISION,myid
     &                 ,my_comm_local,ierr)
      end 

      subroutine bcast_int(int,n,myid)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,int,myid
         integer ierr
         call MPI_BCast(int,n,MPI_INTEGER,myid,my_comm_local,ierr)
      end

      subroutine bcast_char(ch,n,myid)
	implicit none
	include 'tas.cm'
         include 'mpif.h'
	integer n,ierr,myid
	character ch*20
        call mpi_bcast(ch,20,mpi_character,myid,my_comm_local,ierr)
      end

c---------------------------------------------------------------------
      subroutine sum_reduce(r)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer ierr
         real*8 r,temp
         temp =r
         call MPI_AllReduce(temp,r,1,MPI_DOUBLE_PRECISION,MPI_SUM
     &                     ,my_comm_local,ierr)
      end

      subroutine sum_reduce_int(i)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer ierr
         integer i,temp
         temp =i
         call MPI_AllReduce(temp,i,1,MPI_INTEGER,MPI_SUM,my_comm_local,
     >                      ierr)
      end

      subroutine sum_reduce_array(v,tmp,n)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer ierr,n,i
         real*8 v(n),tmp(n)
         do i=1,n
            tmp(i) =v(i)
         enddo
         call MPI_AllReduce(tmp,v,n,MPI_DOUBLE_PRECISION,MPI_SUM
     &                     ,my_comm_local,ierr)
      end

      subroutine sum_reduce_int_array(v,tmp,n)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer ierr,n,i
         integer v(n),tmp(n)
         do i=1,n
            tmp(i) =v(i)
         enddo
         call MPI_AllReduce(tmp,v,n,MPI_INTEGER,MPI_SUM
     &                     ,my_comm_local,ierr)
      end

c --------------------------------------------------------------------
      subroutine send_dble(a,n,iproc,itag)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,iproc,itag
         real*8 a(n)
         integer ierr

         call MPI_Send(a,n,MPI_DOUBLE_PRECISION,iproc,itag
     &                ,my_comm_local,ierr)
      end

      subroutine send_int(a,n,iproc,itag)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,iproc,itag,a(n),ierr

         call MPI_Send(a,n,MPI_INTEGER,iproc,itag
     &                ,my_comm_local,ierr)
      end

      subroutine recv_dble(a,n,itag)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,itag
         real*8 a(n)
         integer ierr,status(MPI_STATUS_SIZE)

         call MPI_Recv(a,n,MPI_DOUBLE_PRECISION,0,itag
     &                ,my_comm_local,status,ierr)
      end

      subroutine recv_int(a,n,itag)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,itag,a(n),ierr,status(MPI_STATUS_SIZE)

         call MPI_Recv(a,n,MPI_INTEGER,0,itag
     &                ,my_comm_local,status,ierr)
      end

      subroutine recv_dble_any(a,n,itag,iproc)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,itag,iproc
         real*8 a(n)
         integer ierr,status(MPI_STATUS_SIZE)

         call MPI_Recv(a,n,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE
     &                ,itag,my_comm_local,status,ierr)
         iproc=status(MPI_SOURCE)
c        itag=status(MPI_TAG)
      end

      subroutine recv_int_any(a,n,itag,iproc)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,itag,a(n),ierr,status(MPI_STATUS_SIZE),iproc

         call MPI_Recv(a,n,MPI_INTEGER,MPI_ANY_SOURCE
     &                ,itag,my_comm_local,status,ierr)
         iproc=status(MPI_SOURCE)
c        itag=status(MPI_TAG)
      end

      subroutine recv_dble_id(a,n,itag,iproc)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,itag,iproc,ip
         real*8 a(n)
         integer ierr,status(MPI_STATUS_SIZE)

         call MPI_Recv(a,n,MPI_DOUBLE_PRECISION,iproc
     &                ,itag,my_comm_local,status,ierr)
         ip=status(MPI_SOURCE)
         if (ip.ne.iproc) 
     &      write (6,*) 'recv_dble_id error: iproc,ip',iproc,ip
c        itag=status(MPI_TAG)
      end

      subroutine recv_int_id(a,n,itag,iproc)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         integer n,itag,a(n),ierr,status(MPI_STATUS_SIZE),iproc

         call MPI_Recv(a,n,MPI_INTEGER,iproc
     &                ,itag,my_comm_local,status,ierr)
c        iproc=status(MPI_SOURCE)
c        itag=status(MPI_TAG)
      end


c ----------------------------------------------------------------
      subroutine second(ttt)
         implicit none
         include 'tas.cm'
         include 'mpif.h'
         real*8 ttt
     
         ttt=MPI_WTIME()
      end