!
! Copyright (C) 2002-2003 PWSCF-FPMD-CP90 group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!

#if defined __HPM
#  include "/cineca/prod/hpm/include/f_hpm.h"
#endif



!------------------------------------------------------------------------------!
    MODULE mp
!------------------------------------------------------------------------------!
      USE kinds,     ONLY : dbl, i4b
      USE io_global, ONLY : stdout
      USE parallel_include
      IMPLICIT NONE

!      PRIVATE
      PUBLIC :: mp_start, mp_end, mp_env, mp_group, mp_cart_create, &
        mp_bcast, mp_stop, mp_sum, mp_max, mp_min, mp_rank, mp_size, &
        mp_excng, mp_gather, mp_get, mp_put, mp_barrier, mp_report
!
      INTERFACE mp_excng    ! Carlo Cavazzoni
        MODULE PROCEDURE mp_excng_i
      END INTERFACE

      INTERFACE mp_bcast
#if defined __T3E
        MODULE PROCEDURE mp_bcast_i1, mp_bcast_r1, mp_bcast_c1, &
          mp_bcast_z, mp_bcast_zv, &
          mp_bcast_iv, mp_bcast_rv, mp_bcast_cv, mp_bcast_l, mp_bcast_rm, &
          mp_bcast_cm, mp_bcast_im, mp_bcast_it, mp_bcast_rt, mp_bcast_lv, &
          mp_bcast_lm, mp_bcast_r4d, mp_bcast_ct, mp_bcast_c4d, &
          mp_bcast_i4b
#else
        MODULE PROCEDURE mp_bcast_i1, mp_bcast_r1, mp_bcast_c1, &
          mp_bcast_z, mp_bcast_zv, &
          mp_bcast_iv, mp_bcast_rv, mp_bcast_cv, mp_bcast_l, mp_bcast_rm, &
          mp_bcast_cm, mp_bcast_im, mp_bcast_it, mp_bcast_rt, mp_bcast_lv, &
          mp_bcast_lm, mp_bcast_r4d, mp_bcast_ct,  mp_bcast_c4d
#endif
      END INTERFACE

      INTERFACE mp_sum
        MODULE PROCEDURE mp_sum_i1, mp_sum_iv, mp_sum_im, mp_sum_it, & 
          mp_sum_r1, mp_sum_rv, mp_sum_rm, mp_sum_rt, &
          mp_sum_c1, mp_sum_cv, mp_sum_cm, mp_sum_ct, mp_sum_c4d, &
          mp_sum_rmm, mp_sum_cmm
      END INTERFACE

      INTERFACE mp_get
        MODULE PROCEDURE mp_get_rv, mp_get_cv, mp_get_i1, mp_get_iv, &
          mp_get_rm
      END INTERFACE

      INTERFACE mp_put
        MODULE PROCEDURE mp_put_rv, mp_put_cv, mp_put_i1, mp_put_iv, &
          mp_put_rm
      END INTERFACE

      INTERFACE mp_max
        MODULE PROCEDURE mp_max_i, mp_max_r, mp_max_rv, mp_max_iv
      END INTERFACE
      INTERFACE mp_min
        MODULE PROCEDURE mp_min_i, mp_min_r, mp_min_rv, mp_min_iv
      END INTERFACE
      INTERFACE mp_gather
        MODULE PROCEDURE mp_gather_iv, mp_gather_cvv, mp_gather_rvv
      END INTERFACE

      INTEGER, PRIVATE, SAVE :: mp_high_watermark = 0

      INTEGER, PRIVATE, PARAMETER :: mp_msgsiz_max = 900000000

!------------------------------------------------------------------------------!
!
    CONTAINS
!
!------------------------------------------------------------------------------!
!
!------------------------------------------------------------------------------!
!..mp_excng
!..Carlo Cavazzoni
!     THIS SUBROUTINE performs the following operation :
!
!               ARRAY                      ARRAY
!     P0   [D0][  ][  ][  ]           [D0][D1][D2][D3]
!     P1   [  ][D1][  ][  ]    --\    [D0][D1][D2][D3]
!     P2   [  ][  ][D2][  ]    --/    [D0][D1][D2][D3]
!     P3   [  ][  ][  ][D3]           [D0][D1][D2][D3]

      SUBROUTINE mp_excng_i(mydata, alldata, gid)
        IMPLICIT NONE
        INTEGER, INTENT(IN) :: mydata
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER, INTENT(OUT) :: alldata(:)
        INTEGER :: taskid, ierr
        INTEGER :: msglen = 1

#if defined (__MPI)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8900)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_comm_rank(group, taskid, ierr)
        IF (ierr/=0) CALL mp_stop(8001)
        alldata(taskid+1) = mydata
        CALL MPI_ALLGATHER(mydata, 1, MPI_INTEGER, alldata, 1, MPI_INTEGER, group, IERR)
        IF (ierr/=0) CALL mp_stop(8001)
#else
        alldata(1) = mydata
#endif
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
        RETURN
      END SUBROUTINE mp_excng_i

!------------------------------------------------------------------------------!
!..mp_gather_iv
!..Carlo Cavazzoni
      SUBROUTINE mp_gather_iv(mydata, alldata, root, gid)
        IMPLICIT NONE
        INTEGER, INTENT(IN) :: mydata(:), root
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER, INTENT(OUT) :: alldata(:,:)
        INTEGER :: msglen, ierr


#if defined (__MPI)
        msglen = SIZE(mydata)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8901)
        IF( msglen .NE. SIZE(alldata, 1) ) CALL mp_stop(8002)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL MPI_GATHER(mydata, msglen, MPI_INTEGER, alldata, msglen, MPI_INTEGER, root, group, IERR)
        IF (ierr/=0) CALL mp_stop(8001)
#else
        msglen = SIZE(mydata)
        IF( msglen .NE. SIZE(alldata, 1) ) CALL mp_stop(8002)
        alldata(:,1) = mydata(:)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
        RETURN
      END SUBROUTINE mp_gather_iv

!------------------------------------------------------------------------------!
!..mp_gather_cvv
!..Carlo Cavazzoni
      SUBROUTINE mp_gather_cvv(mydata, alldata, root, gid)
        IMPLICIT NONE
        COMPLEX(dbl), INTENT(IN) :: mydata(:)
        COMPLEX(dbl), INTENT(OUT) :: alldata(:)
        INTEGER, INTENT(IN) :: root
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined (__MPI)
        group = MPI_COMM_WORLD
        msglen = SIZE(mydata)
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8902)
        IF( PRESENT( gid ) ) group = gid
        CALL MPI_GATHER(mydata, msglen, MPI_DOUBLE_COMPLEX, alldata, msglen, &
          MPI_DOUBLE_COMPLEX, root, group, IERR)
        IF (ierr/=0) CALL mp_stop(8001)
#else
        msglen = SIZE(mydata)
        alldata = mydata
#endif
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen ) 
        RETURN
      END SUBROUTINE mp_gather_cvv

!------------------------------------------------------------------------------!
!..mp_gather_rvv
!..Carlo Cavazzoni
      SUBROUTINE mp_gather_rvv(mydata, alldata, root, gid)
        IMPLICIT NONE
        REAL(dbl), INTENT(IN) :: mydata(:)
        REAL(dbl), INTENT(OUT) :: alldata(:)
        INTEGER, INTENT(IN) :: root
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined (__MPI)
        group = mpi_comm_world
        msglen = SIZE(mydata)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8903)
        IF( PRESENT( gid ) ) group = gid
        CALL MPI_GATHER(mydata, msglen, MPI_DOUBLE_PRECISION, alldata, msglen, &
          MPI_DOUBLE_PRECISION, root, group, IERR)
        IF (ierr/=0) CALL mp_stop(8001)
#else
        msglen = SIZE(mydata)
        alldata = mydata
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
        return
      END SUBROUTINE mp_gather_rvv


!
!------------------------------------------------------------------------------!
!..mp_start
      SUBROUTINE mp_start

! ...
        IMPLICIT NONE
        INTEGER :: ierr, taskid
! ...
        ierr = 0
        taskid = 0

#if defined(__MPI) || defined (__SHMEM)
        CALL MPI_INIT(ierr)
        IF (ierr/=0) CALL mp_stop(8000)
#endif

#if defined __HPM && defined __AIX

        !   initialize the IBM Harware performance monitor
      
#  if defined(__MPI) || defined (__SHMEM)
        CALL mpi_comm_rank( mpi_comm_world, taskid, ierr)
#  endif
        CALL f_hpminit( taskid, 'profiling' )
#endif
! ...

      END SUBROUTINE mp_start
!
!------------------------------------------------------------------------------!
!..mp_end

      SUBROUTINE mp_end
        IMPLICIT NONE
        INTEGER :: ierr, taskid

        ierr = 0
        taskid = 0

#if defined __HPM && defined __AIX

        !   terminate the IBM Harware performance monitor

#  if defined(__MPI)
        CALL mpi_comm_rank( mpi_comm_world, taskid, ierr)
#  endif
        CALL f_hpmterminate( taskid )
#endif

#if defined(__MPI)
        CALL mpi_finalize(ierr)
        IF (ierr/=0) CALL mp_stop(8904)
#endif
        RETURN
      END SUBROUTINE mp_end
!
!------------------------------------------------------------------------------!
!..mp_env

      SUBROUTINE mp_env(numtask, taskid, groupid)
        IMPLICIT NONE
        INTEGER, INTENT (OUT) :: numtask, taskid, groupid
        INTEGER :: ierr

        ierr = 0
        numtask = 1
        taskid = 0
        groupid = 0

#if defined(__MPI)

        CALL mpi_comm_rank(mpi_comm_world,taskid,ierr)
        IF (ierr/=0) CALL mp_stop(8001)
        CALL mpi_comm_size(mpi_comm_world,numtask,ierr)
        groupid = mpi_comm_world
        IF (ierr/=0) CALL mp_stop(8002)

#endif

        RETURN
      END SUBROUTINE mp_env
!------------------------------------------------------------------------------!
!..mp_group
      SUBROUTINE mp_group(group_list, group_size, base_group, groupid)
        IMPLICIT NONE
        INTEGER, INTENT (IN) :: group_list(:), group_size, base_group
        INTEGER, INTENT (OUT) :: groupid
        INTEGER :: base, newgroup, ierr

        ierr = 0
        groupid = base_group
#if defined(__MPI)
        CALL mpi_comm_group(base_group,base,ierr)
        IF (ierr/=0) CALL mp_stop(8010)
        CALL mpi_group_incl(base,group_size,group_list,newgroup,ierr)
        IF (ierr/=0) CALL mp_stop(8011)
        CALL mpi_comm_create(base_group,newgroup,groupid,ierr)
        IF (ierr/=0) CALL mp_stop(8012)
#endif
      END SUBROUTINE mp_group
!------------------------------------------------------------------------------!
!..mp_cart_create
      SUBROUTINE mp_cart_create(comm_old,ndims,dims,pos,comm_cart)
        IMPLICIT NONE
        INTEGER, INTENT (IN) :: comm_old, ndims
        INTEGER, INTENT (OUT) :: dims(:), pos(:), comm_cart
        INTEGER :: ierr, nodes
        LOGICAL :: period(1:ndims), reorder

        ierr = 0
        dims(1:ndims) = 1
        pos(1:ndims) = 1
        comm_cart = comm_old
#if defined(__MPI)
        dims(1:ndims) = 0
        CALL mpi_comm_size(comm_old,nodes,ierr)
        IF (ierr/=0) CALL mp_stop(8020)
        CALL mpi_dims_create(nodes,ndims,dims,ierr)
        IF (ierr/=0) CALL mp_stop(8021)
        reorder = .TRUE.
        period = .TRUE.
        CALL mpi_cart_create(comm_old,ndims,dims,period,reorder,comm_cart, ierr)
        IF (ierr/=0) CALL mp_stop(8022)
        CALL mpi_cart_get(comm_cart,ndims,dims,period,pos,ierr)
        IF (ierr/=0) CALL mp_stop(8023)
#endif
      END SUBROUTINE mp_cart_create
!------------------------------------------------------------------------------!
!..mp_bcast
      SUBROUTINE mp_bcast_i4b(msg,source,gid)
        IMPLICIT NONE
        INTEGER(i4b) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: source
        INTEGER :: msglen, ierr, imsg

#if defined(__MPI)
        ierr = 0
        msglen = 1
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8905)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        imsg = msg
        CALL mpi_bcast(imsg, msglen, mpi_integer, source, group, ierr)
        msg = imsg
        IF (ierr/=0) CALL mp_stop(8101)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_i4b


!------------------------------------------------------------------------------!
!..mp_bcast
      SUBROUTINE mp_bcast_i1(msg,source,gid)
        IMPLICIT NONE
        INTEGER :: msg
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr

#if defined(__MPI)
        ierr = 0
        msglen = 1
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8906)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_integer,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8101)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_i1
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_bcast_iv(msg,source,gid)
        IMPLICIT NONE
        INTEGER :: msg(:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8907)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_integer,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8102)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_iv
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_bcast_im(msg,source,gid)
        IMPLICIT NONE
        INTEGER :: msg(:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8908)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_integer,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8102)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_im
!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_bcast_it(msg,source,gid)
        IMPLICIT NONE
        INTEGER :: msg(:,:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8909)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_integer,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8102)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_it
!
!------------------------------------------------------------------------------!
!
      SUBROUTINE mp_bcast_r1(msg,source,gid)
        IMPLICIT NONE
        REAL (dbl) :: msg
        INTEGER :: msglen, source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: ierr
#if defined(__MPI)
        ierr = 0
        msglen = 1
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8910)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_precision,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8111)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_r1
!
!------------------------------------------------------------------------------!
!
      SUBROUTINE mp_bcast_rv(msg,source,gid)
        IMPLICIT NONE
        REAL (dbl) :: msg(:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr

#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8911)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_precision,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8112)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_rv
!
!------------------------------------------------------------------------------!
!
      SUBROUTINE mp_bcast_rm(msg,source,gid)
        IMPLICIT NONE
        REAL (dbl) :: msg(:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8912)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_precision,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8113)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_rm
!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_bcast_rt(msg,source,gid)
        IMPLICIT NONE
        REAL (dbl) :: msg(:,:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8913)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_precision,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8113)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_rt
!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_bcast_r4d(msg, source, gid)
        IMPLICIT NONE
        REAL (dbl) :: msg(:,:,:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8914)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg, msglen, mpi_double_precision, source, group, ierr)
        IF (ierr/=0) CALL mp_stop(8113)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_r4d

!------------------------------------------------------------------------------!
!
      SUBROUTINE mp_bcast_c1(msg,source,gid)
        IMPLICIT NONE
        COMPLEX (dbl) :: msg
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = 1
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_complex,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8121)
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_c1
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_bcast_cv(msg,source,gid)
        IMPLICIT NONE
        COMPLEX (dbl) :: msg(:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8916)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_complex,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8122)
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_cv
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_bcast_cm(msg,source,gid)
        IMPLICIT NONE
        COMPLEX (dbl) :: msg(:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8915)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_complex,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8123)
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen )
#endif
      END SUBROUTINE mp_bcast_cm
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_bcast_ct(msg,source,gid)
        IMPLICIT NONE
        COMPLEX (dbl) :: msg(:,:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8915)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_complex,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8123)
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen )
#endif
      END SUBROUTINE mp_bcast_ct

!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_bcast_c4d(msg,source,gid)
        IMPLICIT NONE
        COMPLEX (dbl) :: msg(:,:,:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8915)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_double_complex,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8123)
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_c4d

!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_bcast_l(msg,source,gid)
        IMPLICIT NONE
        LOGICAL :: msg
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = 1
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_bcast(msg,msglen,mpi_logical,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8130)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_l
!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_bcast_lv(msg,source,gid)
        IMPLICIT NONE
        LOGICAL :: msg(:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8916)
        CALL mpi_bcast(msg,msglen,mpi_logical,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8130)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_lv

!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_bcast_lm(msg,source,gid)
        IMPLICIT NONE
        LOGICAL :: msg(:,:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
#if defined(__MPI)
        ierr = 0
        msglen = size(msg)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8916)
        CALL mpi_bcast(msg,msglen,mpi_logical,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8130)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen )
#endif
      END SUBROUTINE mp_bcast_lm


!
!------------------------------------------------------------------------------!
!
      SUBROUTINE mp_bcast_z(msg,source,gid)
        IMPLICIT NONE
        CHARACTER (len=*) :: msg
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr, i
        INTEGER, ALLOCATABLE :: imsg(:)
#if defined(__MPI)
        ierr = 0
        msglen = len(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8917)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
! this is a workaround to avoid problems on the T3E
! at the moment we have a data alignment error when trying to
! broadcast characters on the T3E (not always!)
! JH 3/19/99 on galileo
!       CALL mpi_bcast(msg,msglen,mpi_character,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        ALLOCATE (imsg(1:msglen), STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        DO i = 1, msglen
          imsg(i) = ichar(msg(i:i))
        END DO
        CALL mpi_bcast(imsg,msglen,mpi_integer,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        DO i = 1, msglen
          msg(i:i) = char(imsg(i))
        END DO
        DEALLOCATE (imsg, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_bcast_z
!
!------------------------------------------------------------------------------!
!
!------------------------------------------------------------------------------!
!
      SUBROUTINE mp_bcast_zv(msg,source,gid)
        IMPLICIT NONE
        CHARACTER (len=*) :: msg(:)
        INTEGER :: source
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, m1, m2, ierr, i, j
        INTEGER, ALLOCATABLE :: imsg(:,:)
#if defined(__MPI)
        ierr = 0
        m1 = LEN(msg)
        m2 = SIZE(msg)
        msglen = LEN(msg)*SIZE(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8917)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
! ...      CALL mpi_bcast(msg,msglen,mpi_character,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        ALLOCATE (imsg(1:m1,1:m2), STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        DO j = 1, m2
          DO i = 1, m1
            imsg(i,j) = ichar(msg(j)(i:i))
          END DO
        END DO
        CALL mpi_bcast(imsg,msglen,mpi_integer,source,group,ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        DO j = 1, m2
          DO i = 1, m1
            msg(j)(i:i) = char(imsg(i,j))
          END DO
        END DO
        DEALLOCATE (imsg, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8140)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen )
#endif
      END SUBROUTINE mp_bcast_zv
!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_get_i1(msg_dest, msg_sour, mpime, dest, sour, ip, gid)
        INTEGER :: msg_dest, msg_sour
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen = 1

#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif

        IF(dest .NE. sour) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, msglen, MPI_INTEGER, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, msglen, MPI_INTEGER, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
        END IF
#endif
        ELSE
          msg_dest = msg_sour
        END IF

#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 

        RETURN
      END SUBROUTINE

!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_get_iv(msg_dest, msg_sour, mpime, dest, sour, ip, gid)
        INTEGER :: msg_dest(:), msg_sour(:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen

#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif

        IF(sour .NE. dest) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          msglen = SIZE(msg_sour)
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_INTEGER, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_INTEGER, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour)) = msg_sour(:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8918)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
        RETURN
      END SUBROUTINE

!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_get_rv(msg_dest, msg_sour, mpime, dest, sour, ip, gid)
        REAL (dbl) :: msg_dest(:), msg_sour(:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen

#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif

        IF(sour .NE. dest) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          msglen = SIZE(msg_sour) 
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour)) = msg_sour(:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8919)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
        RETURN
      END SUBROUTINE

!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_get_rm(msg_dest, msg_sour, mpime, dest, sour, ip, gid)
        REAL (dbl) :: msg_dest(:,:), msg_sour(:,:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen

#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif

        IF(sour .NE. dest) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = SIZE(msg_sour)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour,1), 1:SIZE(msg_sour,2)) = msg_sour(:,:)
          msglen = SIZE( msg_sour )
        END IF
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8920)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
        RETURN
      END SUBROUTINE


!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_get_cv(msg_dest, msg_sour, mpime, dest, sour, ip, gid)
        COMPLEX (dbl) :: msg_dest(:), msg_sour(:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen

#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif

        IF( dest .NE. sour ) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_COMPLEX, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = SIZE(msg_sour)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_COMPLEX, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_COMPLEX, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour)) = msg_sour(:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8921)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen ) 
        RETURN
      END SUBROUTINE
!------------------------------------------------------------------------------!
!
!
!------------------------------------------------------------------------------!


      SUBROUTINE mp_put_i1(msg_dest, msg_sour, mpime, sour, dest, ip, gid)
        INTEGER :: msg_dest, msg_sour
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen

#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif

        IF(dest .NE. sour) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, 1, MPI_INTEGER, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = 1
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, 1, MPI_INTEGER, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = 1
        END IF
#endif
        ELSE
          msg_dest = msg_sour
          msglen = 1
        END IF
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8922)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
        RETURN
      END SUBROUTINE

!------------------------------------------------------------------------------!
!
!
      SUBROUTINE mp_put_iv(msg_dest, msg_sour, mpime, sour, dest, ip, gid)
        INTEGER :: msg_dest(:), msg_sour(:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif
        IF(sour .NE. dest) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_INTEGER, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = SIZE(msg_sour)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_INTEGER, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour)) = msg_sour(:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8923)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
        RETURN
      END SUBROUTINE

!------------------------------------------------------------------------------!
!
!
      SUBROUTINE mp_put_rv(msg_dest, msg_sour, mpime, sour, dest, ip, gid)
        REAL (dbl) :: msg_dest(:), msg_sour(:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif
        IF(sour .NE. dest) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = SIZE(msg_sour)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour)) = msg_sour(:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8924)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
        RETURN
      END SUBROUTINE

!------------------------------------------------------------------------------!
!
!
      SUBROUTINE mp_put_rm(msg_dest, msg_sour, mpime, sour, dest, ip, gid)
        REAL (dbl) :: msg_dest(:,:), msg_sour(:,:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif
        IF(sour .NE. dest) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = SIZE(msg_sour)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour,1),1:SIZE(msg_sour,2)) = msg_sour(:,:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8925)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
        RETURN
      END SUBROUTINE


!------------------------------------------------------------------------------!
!
!
      SUBROUTINE mp_put_cv(msg_dest, msg_sour, mpime, sour, dest, ip, gid)
        COMPLEX (dbl) :: msg_dest(:), msg_sour(:)
        INTEGER, INTENT(IN) :: dest, sour, ip, mpime
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
#if defined(__MPI)
        INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
        INTEGER :: ierr, nrcv
        INTEGER :: msglen
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
#endif
        IF( dest .NE. sour ) THEN
#if defined(__MPI)
        IF(mpime .EQ. sour) THEN
          CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_COMPLEX, dest, ip, group, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = SIZE(msg_sour)
        END IF
        IF(mpime .EQ. dest) THEN
          CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_COMPLEX, sour, ip, group, istatus, IERR )
          IF (ierr/=0) CALL mp_stop(8140)
          CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_COMPLEX, nrcv, ierr)
          IF (ierr/=0) CALL mp_stop(8140)
          msglen = nrcv
        END IF
#endif
        ELSE
          msg_dest(1:SIZE(msg_sour)) = msg_sour(:)
          msglen = SIZE(msg_sour)
        END IF
        IF( msglen*16 > mp_msgsiz_max ) CALL mp_stop(8926)
#if defined(__MPI)
        CALL MPI_BARRIER(group, IERR)
        IF (ierr/=0) CALL mp_stop(8140)
#endif
        mp_high_watermark = MAX( mp_high_watermark, 16 * msglen ) 
        RETURN
      END SUBROUTINE

!
!------------------------------------------------------------------------------!
!
!..mp_stop
!
      SUBROUTINE mp_stop(code)
        IMPLICIT NONE
        INTEGER, INTENT (IN) :: code
        WRITE( stdout, fmt='( "*** error in Message Passing (mp) module ***")' )
        WRITE( stdout, fmt='( "*** error code: ",I5)' ) code
#if defined(__MPI)
        CALL mpi_abort(mpi_comm_world,code)
#endif
        STOP
      END SUBROUTINE mp_stop
!------------------------------------------------------------------------------!
!
!..mp_sum
      SUBROUTINE mp_sum_i1(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, res, ierr

        msglen = 1
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_allreduce(msg,res,msglen,mpi_integer,mpi_sum,group,ierr)
        IF (ierr/=0) CALL mp_stop(8200)
        msg = res
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_sum_i1
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_sum_iv(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        INTEGER, ALLOCATABLE :: res(:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8927)
        ALLOCATE (res(1:msglen),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8201)
        CALL mpi_allreduce(msg,res,msglen,mpi_integer,mpi_sum,group,ierr)
        IF (ierr/=0) CALL mp_stop(8200)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8202)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_sum_iv
!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_im(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg(:,:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, m1, m2, ierr
        INTEGER, ALLOCATABLE :: res(:,:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8928)
        m1 = size(msg(:,1))
        m2 = size(msg(1,:))
        ALLOCATE (res(m1,m2),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_integer,mpi_sum,group,ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_sum_im
!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_it(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg(:,:,:)
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, m1, m2, m3, ierr
        INTEGER, ALLOCATABLE :: res(:,:,:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8929)
        m1 = size(msg,1)
        m2 = size(msg,2)
        m3 = size(msg,3)
        ALLOCATE (res(m1,m2,m3),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_integer,mpi_sum,group,ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_sum_it

!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_r1(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        REAL (dbl) :: res
#if defined(__MPI)
        msglen = 1
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group,ierr)
        IF (ierr/=0) CALL mp_stop(8203)
        msg = res
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_r1

!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_rv(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        REAL (dbl), ALLOCATABLE :: res(:)
#if defined(__MPI)
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8930)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        ALLOCATE (res(1:msglen),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group, ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_rv
!
!------------------------------------------------------------------------------!


      SUBROUTINE mp_sum_rm(msg, gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg(:,:)
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, m1, m2, ierr, i, j, k
        REAL (dbl), ALLOCATABLE :: res(:,:)
        REAL (dbl), ALLOCATABLE :: resv(:)
#if defined(__MPI)
        msglen = size(msg)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid

        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8931)
        m1 = size(msg(:,1))
        m2 = size(msg(1,:))
        ALLOCATE (res(m1,m2),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg, res, msglen, mpi_double_precision, mpi_sum, group, ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8205)

        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 

#endif

      END SUBROUTINE mp_sum_rm
!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_rmm(msg, res, root, gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (IN) :: msg(:,:)
        REAL (dbl), INTENT (OUT) :: res(:,:)
        INTEGER, OPTIONAL, INTENT (IN) :: root
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr, j

        msglen = size(msg)

#if defined(__MPI)

        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid

        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8932)

        IF( PRESENT( root ) ) THEN
          CALL mpi_reduce(msg, res, msglen, mpi_double_precision, mpi_sum, root, group, ierr)
        ELSE
          CALL mpi_allreduce(msg, res, msglen, mpi_double_precision, mpi_sum, group, ierr)
        END IF
        IF (ierr/=0) CALL mp_stop(8205)

#else
        res = msg
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 

      END SUBROUTINE mp_sum_rmm


!
!------------------------------------------------------------------------------!


      SUBROUTINE mp_sum_rt(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg(:,:,:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, m1, m2, m3, ierr
        REAL (dbl), ALLOCATABLE :: res(:,:,:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8933)
        m1 = size(msg,1)
        m2 = size(msg,2)
        m3 = size(msg,3)
        ALLOCATE (res(m1,m2,m3),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group, ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8205)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_rt

!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_c1(msg,gid)
        IMPLICIT NONE
        COMPLEX (dbl), INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        COMPLEX (dbl) :: res

#if defined(__MPI)
        msglen = 2
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group,ierr)
        msg = res
        IF (ierr/=0) CALL mp_stop(8205)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_c1
!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_cv(msg,gid)
        IMPLICIT NONE
        COMPLEX (dbl), INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        COMPLEX (dbl), ALLOCATABLE :: res(:)
#if defined(__MPI)
        msglen = 2*size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8934)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        ALLOCATE (res(1:size(msg)),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8206)
        CALL mpi_allreduce(msg(1),res(1),msglen,mpi_double_precision,mpi_sum,group, ierr)
        IF (ierr/=0) CALL mp_stop(8207)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8207)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_cv
!
!------------------------------------------------------------------------------!

      SUBROUTINE mp_sum_cm(msg, gid)
        IMPLICIT NONE
        COMPLEX (dbl), INTENT (INOUT) :: msg(:,:)
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, m1, m2, ierr
        COMPLEX (dbl), ALLOCATABLE :: res(:,:)
#if defined(__MPI)
        msglen = 2*size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8935)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        m1 = size(msg(:,1))
        m2 = size(msg(1,:))
        ALLOCATE (res(m1,m2),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group, ierr)
        IF (ierr/=0) CALL mp_stop(8208)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8208)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_cm
!
!------------------------------------------------------------------------------!


      SUBROUTINE mp_sum_cmm(msg, res, gid)
        IMPLICIT NONE
        COMPLEX (dbl), INTENT (IN) :: msg(:,:)
        COMPLEX (dbl), INTENT (OUT) :: res(:,:)
        INTEGER, OPTIONAL, INTENT (IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        msglen = 2*size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8936)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL mpi_allreduce(msg, res, msglen, mpi_double_precision, mpi_sum, group, ierr)
        IF (ierr/=0) CALL mp_stop(8208)
#else
        res = msg
#endif
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
      END SUBROUTINE mp_sum_cmm


!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_sum_ct(msg,gid)
        IMPLICIT NONE
        COMPLEX (dbl), INTENT (INOUT) :: msg(:,:,:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: i, msglen, ierr
        COMPLEX (dbl), ALLOCATABLE :: res(:,:,:)
#if defined(__MPI)
        msglen = 2 * SIZE(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8937)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        ALLOCATE (res(size(msg,1),size(msg,2),size(msg,3)),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group,ierr)
        IF (ierr/=0) CALL mp_stop(8208)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8208)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_ct

!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
      SUBROUTINE mp_sum_c4d(msg,gid)
        IMPLICIT NONE
        COMPLEX (dbl), INTENT (INOUT) :: msg(:,:,:,:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: i, msglen, ierr
        COMPLEX (dbl), ALLOCATABLE :: res(:,:,:,:)
#if defined(__MPI)
        msglen = 2*size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8938)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        ALLOCATE (res(size(msg,1),size(msg,2),size(msg,3),size(msg,4)), STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8204)
        CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group, ierr)
        IF (ierr/=0) CALL mp_stop(8208)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8208)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_sum_c4d


!------------------------------------------------------------------------------!
      SUBROUTINE mp_max_i(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        INTEGER :: res
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = 1
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_INTEGER,MPI_MAX,group,IERR)
        IF (ierr/=0) CALL mp_stop(8300)
        msg = res
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_max_i
!
!------------------------------------------------------------------------------!
!
!..mp_max_iv
!..Carlo Cavazzoni
!
      SUBROUTINE mp_max_iv(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        INTEGER, ALLOCATABLE :: res(:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8939)
        ALLOCATE (res(1:msglen),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8302)
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_INTEGER, MPI_MAX,group,IERR)
        IF (ierr/=0) CALL mp_stop(8303)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8303)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_max_iv
!
!----------------------------------------------------------------------

      SUBROUTINE mp_max_r(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        REAL (dbl) :: res
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = 1
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_DOUBLE_PRECISION, MPI_MAX,group,IERR)
        IF (ierr/=0) CALL mp_stop(8301)
        msg = res
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_max_r
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_max_rv(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        REAL (dbl), ALLOCATABLE :: res(:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8940)
        ALLOCATE (res(1:msglen),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8302)
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_DOUBLE_PRECISION, MPI_MAX,group,IERR)
        IF (ierr/=0) CALL mp_stop(8303)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8303)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_max_rv
!------------------------------------------------------------------------------!
      SUBROUTINE mp_min_i(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        INTEGER :: res
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = 1
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_INTEGER,MPI_MIN,group,IERR)
        IF (ierr/=0) CALL mp_stop(8310)
        msg = res
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_min_i
!------------------------------------------------------------------------------!
      SUBROUTINE mp_min_iv(msg,gid)
        IMPLICIT NONE
        INTEGER, INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        INTEGER, ALLOCATABLE :: res(:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = SIZE(msg)
        IF( msglen*4 > mp_msgsiz_max ) CALL mp_stop(8941)
        ALLOCATE (res(1:msglen),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8312)
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_INTEGER,MPI_MIN,group,IERR)
        IF (ierr/=0) CALL mp_stop(8313)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8313)
        mp_high_watermark = MAX( mp_high_watermark, 4 * msglen ) 
#endif
      END SUBROUTINE mp_min_iv
!------------------------------------------------------------------------------!
      SUBROUTINE mp_min_r(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        REAL (dbl) :: res
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = 1
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_DOUBLE_PRECISION, MPI_MIN,group,IERR)
        IF (ierr/=0) CALL mp_stop(8311)
        msg = res
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_min_r
!
!------------------------------------------------------------------------------!
      SUBROUTINE mp_min_rv(msg,gid)
        IMPLICIT NONE
        REAL (dbl), INTENT (INOUT) :: msg(:)
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: msglen, ierr
        REAL (dbl), ALLOCATABLE :: res(:)
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        msglen = size(msg)
        IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8942)
        ALLOCATE (res(1:msglen),STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8312)
        CALL MPI_ALLREDUCE(MSG,res,msglen,MPI_DOUBLE_PRECISION, MPI_MIN,group,IERR)
        IF (ierr/=0) CALL mp_stop(8313)
        msg = res
        DEALLOCATE (res, STAT=ierr)
        IF (ierr/=0) CALL mp_stop(8313)
        mp_high_watermark = MAX( mp_high_watermark, 8 * msglen ) 
#endif
      END SUBROUTINE mp_min_rv

!------------------------------------------------------------------------------!

      SUBROUTINE mp_barrier(gid)
        IMPLICIT NONE
        INTEGER, OPTIONAL, INTENT(IN) :: gid
        INTEGER :: group
        INTEGER :: ierr
#if defined(__MPI)
        group = mpi_comm_world
        IF( PRESENT( gid ) ) group = gid
        CALL MPI_BARRIER(group,IERR)
        IF (ierr/=0) CALL mp_stop(8313)
#endif
      END SUBROUTINE mp_barrier

!------------------------------------------------------------------------------!
!.. Carlo Cavazzoni
!..mp_rank
      FUNCTION mp_rank()
        IMPLICIT NONE
        INTEGER :: mp_rank
        INTEGER :: ierr, taskid

        ierr = 0
        taskid = 0
#if defined(__MPI)
        CALL mpi_comm_rank(mpi_comm_world,taskid,ierr)
        IF (ierr/=0) CALL mp_stop(8003)
#endif
        mp_rank = taskid
      END FUNCTION mp_rank

!------------------------------------------------------------------------------!
!.. Carlo Cavazzoni
!..mp_size
      FUNCTION mp_size()
        IMPLICIT NONE
        INTEGER :: mp_size
        INTEGER :: ierr, numtask

        ierr = 0
        numtask = 1
#if defined(__MPI)
        CALL mpi_comm_size(mpi_comm_world,numtask,ierr)
        IF (ierr/=0) CALL mp_stop(8004)
#endif
        mp_size = numtask
      END FUNCTION mp_size

      SUBROUTINE mp_report
        WRITE( stdout, *) 
        WRITE( stdout, *) '  mp: high_watermark (bytes): ', mp_high_watermark
        RETURN
      END SUBROUTINE mp_report


!------------------------------------------------------------------------------!
    END MODULE mp
!------------------------------------------------------------------------------!