CHARMM Element source/machdep/paral2.src 1.1
C Utility routines for parallel CHARMM on MIMD machines.
C
##IFN PARALLEL
      SUBROUTINE NULL_PL2
      RETURN
##ELSE
      SUBROUTINE CMPI_INIT(STATUS)
C-----------------------------------------------------------------------
C Startup for parallel code.
C-----------------------------------------------------------------------
C  This code must be run when CHARMM is started to properly setup all
C  data communication.
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
      INTEGER STATUS,I
C
##INCLUDE '~/charmm_fcm/dimens.fcm'
##INCLUDE '~/charmm_fcm/parallel.fcm'
##INCLUDE '~/charmm_fcm/lobos.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
##INCLUDE '~/charmm_fcm/number.fcm'
C
##IF CM5
      INCLUDE '/usr/include/cm/cmmd_fort.h'
##ENDIF
##IF T3D T3E
      integer   log2npes, my_pe
      intrinsic my_pe
##ENDIF
##IF MPI
      INCLUDE 'mpi/mpif.h'
##ENDIF
C
##IF INTEGER8
      INTEGER*4 MSTATUS, MCOMM
##ENDIF
##IF PARASCAL
      NPART=8
##ENDIF
C
##IF SOCKET
C Code for TCP/IP Berkeley sockets - This comes first to
C support mnod()and  nnod() functions.
C
      CALL EXECUTE_STACK
C
##ELIF PVMC
C     Spawn CHARMM to the whole PVM
      CALL PVMINI
##ELIF PVM
      CALL PVMFBEGIN(NUMNOD,TID,MYNOD)
##ELIF MPI
##IF INTEGER8
C Convert integer*8 arguments to integer*4 for external library

##IF GAMESSUK
      CALL PARALLEL_INIT(STATUS)
##ELSE
      CALL MPI_INIT(MSTATUS)
      STATUS = MSTATUS
##ENDIF
      MCOMM = MPI_COMM_WORLD
      CALL MPI_BARRIER(MCOMM,MSTATUS)
      STATUS=MSTATUS
##ELSE
      CALL MPI_INIT(STATUS)
      CALL MPI_BARRIER(MPI_COMM_WORLD,STATUS)
##ENDIF
C
##ENDIF
C
##IF CSPP
      IF(MYNOD.EQ.0) CALL OUTBUF(6)
##ENDIF
C
C     MYNODE - who am I
C     NUMNOD - how many we are all together
C
C     This is for all parallel systems
C
      MYNOD = MNOD()
      NUMNOD = NNOD()
      NODDIM = NPTWO()
C
CCC      WRITE(*,*)'PARSTRT>ME,NUMNOD,NDIM',MYNOD,NUMNOD,NODDIM
C
C     NUMNOD is 0 if using csh. Put it back to 1!
      IF(NUMNOD.EQ.0) NUMNOD = 1
CCC     $   CALL WRNDIE(-5,'<PARSTRT>','Cannot run CHARMM on zero nodes.')
##IF DELTA PARAGON
C     Special code for remapping the hypercube
C     to mesh architecture
C
      CALL MESH(MYNOD,IPPMAP)
C
##ELIF INTEL
C For the hypercube, it stays simple.
C
      CALL CUBE(MYNOD,NUMNOD,IPPMAP)
C
##ELIF CM5
C Code for Thinking Machine, CM-5
C
      MYNOD = CMMD_self_address()
      NUMNOD=CMMD_partition_size()
C
      DIMX=-1
      DO I = 0,16
         IF(2**I.EQ.NUMNOD) DIMX=I
      ENDDO
      IF(DIMX.LT.0) CALL DIE
      NODDIM=DIMX
C
      DO INOD = 0,NUMNOD-1
         IPPMAP(INOD)=INOD
      ENDDO
C
##ELIF SOCKET
C
      CALL CUBE(MYNOD,NUMNOD,IPPMAP)
C
##ELIF T3D T3E
      mynod=my_pe()
      numnod=n$pes
      noddim = log2npes()
      CALL CUBE(MYNOD,NUMNOD,IPPMAP)
##IF SHMEM
      if( mynod .eq. 0 ) write( outu, * ) ' USING SHMEM'
##ELSE
      if( mynod .eq. 0 ) write( outu, * ) ' USING PVM3'
##ENDIF

C
##ELIF IBMSP
C
      CALL CUBE(MYNOD,NUMNOD,IPPMAP)
C
##ELIF PVM PVMC MPI
C
      CALL CUBE(MYNOD,NUMNOD,IPPMAP)
C
##ELSE
      CALL WRNDIE(-4,'<PARSTRT>','Unrecognized parallel machine type')
##ENDIF
C
##IF BUFFERED
      NICBUF=2000
##ENDIF
C
      RETURN
      END
C
      SUBROUTINE CMPI_CM_RANK(MPI_COMM_WORLD,MYNOD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
      INTEGER MPI_COMM_WORLD,MYNOD,STATUS,MNOD
      EXTERNAL MNOD
C
      IF(MPI_COMM_WORLD.EQ.0) THEN
         MYNOD=MNOD()
      ELSE
        write(*,*)'CMPI-Error>Other than MPI_COMM_WORLD not supported.'
      ENDIF
      RETURN
      END
C
      SUBROUTINE CMPI_CM_SIZE(MPI_COMM_WORLD,NUMNOD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
      INTEGER MPI_COMM_WORLD,NUMNOD,STATUS,NNOD
      EXTERNAL NNOD
C
      IF(MPI_COMM_WORLD.EQ.0) THEN
         NUMNOD=NNOD()
      ELSE
        write(*,*)'CMPI-Error>Other than MPI_COMM_WORLD not supported.'
      ENDIF
      RETURN
      END
C
      SUBROUTINE CMPI_BARRIER(MPI_COMM_WORLD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      INTEGER MPI_COMM_WORLD,STATUS
C
##INCLUDE '~/charmm_fcm/dimens.fcm'
##INCLUDE '~/charmm_fcm/parallel.fcm'
C
      IF(MPI_COMM_WORLD.EQ.0) THEN
C
C     This is a wrapper routine for global sync.
C
C     Use own gsync algorithm
##IF DELTA PARAGON
      CALL GSYNC()
##ELIF CM5
      INCLUDE '/usr/include/cm/cmmd_fort.h'
C
      CALL CMMD_sync_with_nodes()
##ELIF T3D T3E
      call barrier()
##ELIF GENCOMM
C     The following is IPPMAP safe routine!
      CALL AGGSYNC()
##ELIF PARAFULL
##IF INTEL
      CALL GSYNC()
##ELSE
      CALL APSYNC()
##ENDIF
##ELIF PARASCAL
      CALL AGGSYNC()
##ENDIF ! DELTA PARAGON
C
      ELSE
        write(*,*)'CMPI-Error>Other than MPI_COMM_WORLD not supported.'
      ENDIF
      RETURN
      END
C
##IF T3D T3E
      SUBROUTINE CT3C_BCAST(ARRAY,LENST,LENGTH)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
      CHARACTER*(*) ARRAY(*)
      INTEGER LENST,LENGTH
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
      INTEGER OFFSET,LOG2NPES,I,TYPE
C
      call barrier()
      type=1
      offset = 1
      do i = 1, log2npes()
           if( mynod .lt. offset ) then
               call gsen( mynod+offset, type, lenst, 8 )
               call gsenc( mynod+offset, type, array, lenst*length )
               call barrier()
           else if( mynod .lt. offset+offset ) then
               call grec( mynod-offset, type, lenst, 8 )
               call grecc( mynod-offset, type, array, lenst*length )
               call barrier()
           else
               call barrier()
           end if
           offset = offset+offset
       end do
C
      RETURN
      END
      SUBROUTINE CT3I_BCAST(ARRAY,LENGTH)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
      INTEGER ARRAY(*),LENGTH
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
      INTEGER OFFSET,LOG2NPES,I,TYPE
C
c      call barrier()
      type=1
      offset = 1
      do i = 1, log2npes()
           if( mynod .lt. offset ) then
               call gsenc( mynod+offset, type, array, 8*length )
               call barrier()
           else if( mynod .lt. offset+offset ) then
               call grecc( mynod-offset, type, array, 8*length )
               call barrier()
           else
               call barrier()
           end if
           offset = offset+offset
       end do
C
      RETURN
      END
##ENDIF
C
      SUBROUTINE CMPI_BCAST(ARRAY,LENGTH,SIZE,ROOT,WORLD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
##IFN T3D T3E GNU ULTRA
      BYTE ARRAY(*)                  !##.not.SGIF90
      integer (kind=1) array(*)      !## SGIF90
##ELSE
      INTEGER ARRAY(*)
##ENDIF
      INTEGER LENGTH,SIZE,ROOT,WORLD,STATUS
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
##IF MPI
      INCLUDE 'mpi/mpif.h'
##ELIF T3D T3E
      INTEGER OFFSET
##ENDIF
##IF INTEGER8
      INTEGER*4 MLENGTH,MROOT,MSTATUS,MCOMM,MBYTE
##ENDIF
      INTEGER TYPE,I
C
      IF(WORLD.NE.0) THEN
        STATUS=-1
        write(*,*)'CMPI-Error>Other than MPI_COMM_WORLD not supported.'
        RETURN
      ENDIF
      IF(SIZE.NE.2) THEN
        STATUS=-1
        write(*,*)'CMPI-Error>Other than MPI_BYTE not supported.'
        RETURN
      ENDIF
C
##IF MPI
##IF CONCURR REPLICA
C
C     This code is IPPMAP safe, so it can be used in
C     "group" based parallel methods (CONCURR,QM REPLICA/PATH)
      TYPE=1
      IF (MYNOD.EQ.0) THEN
         CALL GSEN(IPPMAP(MOD(MYNOD+1,NUMNOD)),TYPE,ARRAY,LENGTH)
      ELSE
       CALL GREC(IPPMAP(MOD(MYNOD-1+NUMNOD,NUMNOD)),TYPE,ARRAY,LENGTH)
         IF(MYNODP.LT.NUMNOD)
     $        CALL GSEN(IPPMAP(MOD(MYNOD+1,NUMNOD)),TYPE,ARRAY,LENGTH)
      ENDIF
C
##ELIF INTEGER8
C Convert integer*8 to integer*4 for interface with MPI library
      MLENGTH=LENGTH
      MROOT=ROOT
      MSTATUS=STATUS
      MCOMM = MPI_COMM_WORLD
      MBYTE = MPI_BYTE
      CALL MPI_BCAST(ARRAY,MLENGTH,MBYTE,MROOT,
     &               MCOMM,MSTATUS)
      STATUS=MSTATUS
##ELSE
      CALL MPI_BCAST(ARRAY,LENGTH,MPI_BYTE,ROOT,MPI_COMM_WORLD,STATUS)
##ENDIF
##ELIF T3D T3E
C     Good only for Real*8 see CT3X_BCAST for character and integers
      call barrier()
      type = 1
      offset = 1
      do i = 1, log2npes()
         if( mynod .lt. offset ) then
             call gsen( mynod+offset, type, array, length )
             call barrier()
         else if ( mynod .lt. offset+offset ) then
             call grec( mynod-offset, type, array, length )
             call barrier()
         else
             call barrier()
         endif
         offset = offset + offset
      end do
##ELSE
      TYPE=1
      IF (MYNOD.EQ.0) THEN
##IF GENCOMM
         CALL GSENR(IPPMAP,TYPE, ARRAY, LENGTH)
##ELIF CM5
         CALL CMMD_bc_to_nodes(array, length)
##ELSE
         DO I=1,NUMNOD-1
            CALL GSEN(I,TYPE, ARRAY, LENGTH)
         ENDDO
##ENDIF ! GENCOMM
      ELSE
##IF GENCOMM
         CALL GRECL(IPPMAP,TYPE, ARRAY, LENGTH)
         IF(MYNODP.LT.NUMNOD)CALL GSENR(IPPMAP,TYPE,ARRAY,LENGTH)
##ELIF CM5
         CALL CMMD_receive_bc_from_node(array, length)
##ELSE
         CALL GREC(0,TYPE, ARRAY, LENGTH)
##ENDIF ! GENCOMM
      ENDIF
C
      CALL PSYNC()
CCC      write(*,*)'ME,len,l,arr:',mynod,lenst,length,array(1)(1:8)
C
##ENDIF
C
      RETURN
      END
C
      SUBROUTINE CMPI_RED_SCAT(X,W,KPARPT,SIZE,SUM,WORLD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      REAL*8 X(*),W(*)
      INTEGER KPARPT(0:*),SIZE,SUM,WORLD,STATUS
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
C
      INTEGER I,LPARPT(0:MAXNODE)
C
      IF(SIZE.NE.0)THEN
         STATUS=-1
      ENDIF
      IF(SUM.NE.0)THEN
         STATUS=-2
      ENDIF
      IF(WORLD.NE.0)THEN
         STATUS=-3
      ENDIF
      LPARPT(0)=0
      DO I=0,NUMNOD-1
         LPARPT(I+1)=LPARPT(I)+KPARPT(I)
      ENDDO
      CALL AGVDGS(X,LPARPT,W,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##SYNCHRON
      CALL AGVDGSA(X,LPARPT,W,NUMNOD,MYNOD,IPPMAP) !##GENCOMM !##.not.SYNCHRON
      CALL AVDGSUM(X,LPARPT,W,NODDIM,MYNOD,IPPMAP) !##.not.GENCOMM !##SYNCHRON
      CALL AVDGSA(X,LPARPT,W,NODDIM,MYNOD,IPPMAP)  !##.not.GENCOMM !##.not.SYNCHRON
C
      CALL COPYR8(X(LPARPT(MYNOD)+1),W,KPARPT(MYNOD))
C
      RETURN
      END
C
      SUBROUTINE CMPI_GATHERV(X,KPARPT,XSIZE,W,LPARPT,MPARPT,WSIZE,
     $     WORLD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      REAL*8 X(*),W(*)
      INTEGER KPARPT,LPARPT(0:*),MPARPT(0:*)
      INTEGER XSIZE,WSIZE,WORLD,STATUS
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
C
      STATUS=0
      IF((XSIZE.NE.0).OR.(WSIZE.NE.0))THEN
         STATUS=-1
      ENDIF
      IF(WORLD.NE.0)THEN
         STATUS=-3
      ENDIF
      CALL AGVDGB(X,MPARPT,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##SYNCHRON
      CALL AGVDGBA(X,MPARPT,NUMNOD,MYNOD,IPPMAP) !##GENCOMM !##.not.SYNCHRON
      CALL AVDGBR(X,MPARPT,NODDIM,MYNOD,IPPMAP)  !##.not.GENCOMM !##SYNCHRON
      CALL AVDGBRA(X,MPARPT,NODDIM,MYNOD,IPPMAP) !##.not.GENCOMM !##.not.SYNCHRON
C
      CALL COPYR8(X,W,MPARPT(NUMNOD))
C
      RETURN
      END
C
      SUBROUTINE CIMPI_GATHERV(X,XSIZE,MPARPT,WORLD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      REAL*8 X(*)
      INTEGER MPARPT(0:*)
      INTEGER XSIZE,WORLD,STATUS
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
C
      STATUS=0
      IF(XSIZE.NE.0)THEN
         STATUS=-1
      ENDIF
      IF(WORLD.NE.0)THEN
         STATUS=-3
      ENDIF
      CALL AGVDGB(X,MPARPT,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##SYNCHRON
      CALL AGVDGBA(X,MPARPT,NUMNOD,MYNOD,IPPMAP) !##GENCOMM !##.not.SYNCHRON
      CALL AVDGBR(X,MPARPT,NODDIM,MYNOD,IPPMAP)  !##.not.GENCOMM !##SYNCHRON
      CALL AVDGBRA(X,MPARPT,NODDIM,MYNOD,IPPMAP) !##.not.GENCOMM !##.not.SYNCHRON
C
      RETURN
      END
C
      SUBROUTINE CIMPI_ALLRED(X,W,N,SIZE,OP,WORLD,STATUS)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      REAL*8 X(*),W(*)
      INTEGER SIZE,OP,WORLD,STATUS
C
##INCLUDE '~/charmm_fcm/parallel.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stack.fcm'
C
      INTEGER I,N
C
      STATUS=0
      JPARPT(0)=0
      DO I = 1, NUMNOD
         JPARPT(I)=N*I/NUMNOD
      ENDDO
C
      IF ((SIZE.EQ.0).AND.(OP.EQ.0)) THEN
         CALL AGVDGS(X,JPARPT,W,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##SYNCHRON
         CALL AGVDGB(X,JPARPT,NUMNOD,MYNOD,IPPMAP)    !##GENCOMM !##SYNCHRON
         CALL AGVDGSA(X,JPARPT,W,NUMNOD,MYNOD,IPPMAP) !##GENCOMM !##.not.SYNCHRON
         CALL AGVDGBA(X,JPARPT,NUMNOD,MYNOD,IPPMAP)   !##GENCOMM !##.not.SYNCHRON
         CALL AVDGSUM(X,JPARPT,W,NODDIM,MYNOD,IPPMAP) !##.not.GENCOMM !##SYNCHRON
         CALL AVDGBR(X,JPARPT,NODDIM,MYNOD,IPPMAP)    !##.not.GENCOMM !##SYNCHRON
         CALL AVDGSA(X,JPARPT,W,NODDIM,MYNOD,IPPMAP)  !##.not.GENCOMM !##.not.SYNCHRON
         CALL AVDGBRA(X,JPARPT,NODDIM,MYNOD,IPPMAP)   !##.not.GENCOMM !##.not.SYNCHRON
      ELSEIF ((SIZE.EQ.1).AND.(OP.EQ.0)) THEN
         CALL IGVDGS(X,JPARPT,W,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##SYNCHRON
         CALL IGVDGB(X,JPARPT,NUMNOD,MYNOD,IPPMAP)    !##GENCOMM !##SYNCHRON
         CALL IGVDGS(X,JPARPT,W,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##.not.SYNCHRON
         CALL IGVDGB(X,JPARPT,NUMNOD,MYNOD,IPPMAP)    !##GENCOMM !##.not.SYNCHRON
         CALL IVDGSUM(X,JPARPT,W,NODDIM,MYNOD,IPPMAP) !##.not.GENCOMM
         CALL IVDGBR(X,JPARPT,NODDIM,MYNOD,IPPMAP)    !##.not.GENCOMM
      ELSEIF ((SIZE.EQ.1).AND.(OP.EQ.1)) THEN
         CALL IGVDGO(X,JPARPT,W,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##SYNCHRON
         CALL IGVDGB(X,JPARPT,NUMNOD,MYNOD,IPPMAP)    !##GENCOMM !##SYNCHRON
         CALL IGVDGO(X,JPARPT,W,NUMNOD,MYNOD,IPPMAP)  !##GENCOMM !##.not.SYNCHRON
         CALL IGVDGB(X,JPARPT,NUMNOD,MYNOD,IPPMAP)    !##GENCOMM !##.not.SYNCHRON
         CALL IVDGOR(X,JPARPT,W,NODDIM,MYNOD,IPPMAP)  !##.not.GENCOMM
         CALL IVDGBR(X,JPARPT,NODDIM,MYNOD,IPPMAP)    !##.not.GENCOMM
      ELSE
         STATUS=-1
      ENDIF
C
      RETURN
      END
C
      SUBROUTINE SWAPD1(N,X,XPL,XPR,LPEER,RPEER)
C-----------------------------------------------------------------------
C This routine performs a symple swap of data between X and XP.
C X is on MYNOD and XP is on PEER
C------------------------------------
C MODE =  0   swap between MYNOD and PEER
C MODE = -1   only send to PEER
C MODE =  1   only receive from PEER
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      INTEGER N,LPEER,RPEER
      REAL*8 X(*),XPL(*),XPR(*)
C
      IF((LPEER.GE.0).AND.(RPEER.GE.0)) THEN
         CALL SWAPD3(N,X,XPL,XPR,LPEER,RPEER)
      ELSE IF(LPEER.LT.0) THEN
         CALL GRECSEN(RPEER,1,XPR,N,X,N)
      ELSE
         CALL GRECSEN(LPEER,1,XPL,N,X,N)
      ENDIF
C
      RETURN
      END
C
##IF CONCURR
      SUBROUTINE PARSEP(MYNOD,NUMNOD,IPPMAP,IPMGRP,IPCURR)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      INTEGER MYNOD, NUMNOD, IPPMAP(0:*), IPMGRP, IPCURR
C
##INCLUDE '~/charmm_fcm/stream.fcm'
C
C     Divides the whole job in to parts by reasigning
C     mynod,numnod and ippmap. 
C     This is a quick hack and works just for CMPI model
C
      INTEGER I,MEOLD
C
      I=NUMNOD
      NUMNOD=NUMNOD/IPCURR
      MEOLD=MYNOD
      IF((I.NE.(NUMNOD*IPCURR)).AND.(PRNLEV.GE.2)) THEN
        WRITE(OUTU,'(A,I3,A,I3,A)')'Combination: CONCUR =',IPCURR,
     $        ' and NUMNOD = ',I,' won''t work.'
        CALL WRNDIE(-5,'<PARSEP>','CONCUR must divide NUMNOD.')
      ENDIF
      IPMGRP=MEOLD/NUMNOD
      MYNOD=MOD(MYNOD,NUMNOD)
      DO I=0,NUMNOD
         IPPMAP(I)=I+NUMNOD*IPMGRP
      ENDDO
C
      
      RETURN
      END
C
      SUBROUTINE PGRPIN(IPMGRP,MYNOD,NUMNOD,INTVCN,INTVMX)
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
      INTEGER IPMGRP,MYNOD,NUMNOD,INTVCN,INTVMX
C
##IF MPI
      INCLUDE 'mpi/mpif.h'
C
##IF INTEGER8
      INTEGER*4 REQ(2),STATUS_ARRAY(MPI_STATUS_SIZE,1),
     &          IERR,TYPE,LENGTH,NODE
##ELSE
      INTEGER REQ(2),STATUS_ARRAY(MPI_STATUS_SIZE,1),
     &        IERR,TYPE,LENGTH,NODE
##ENDIF
      CHARACTER*1 B
C
      IF(INTVCN.EQ.-1) RETURN
C
      IF(IPMGRP.EQ.0) THEN
         IF(INTVCN.NE.0) THEN
C
            B='Y'
            TYPE=1
            LENGTH=1
            NODE=MYNOD+NUMNOD
            CALL MPI_ISEND(B,LENGTH,MPI_BYTE,NODE,TYPE,
     $           MPI_COMM_WORLD,REQ(1),IERR)
            IF(IERR.NE.MPI_SUCCESS) 
     @           CALL WRNDIE(-4,'<PGRPIN>','MPI ISEND ERROR')
            LENGTH=1
            NODE=MYNOD+NUMNOD
            CALL MPI_IRECV(B,LENGTH,MPI_BYTE,NODE,TYPE,
     $           MPI_COMM_WORLD,REQ(2),IERR)
            IF(IERR.NE.MPI_SUCCESS) 
     $           CALL WRNDIE(-4,'<PGRPIN>','MPI IRECV ERROR')
            LENGTH=2
            CALL MPI_WAITALL(LENGTH,REQ,STATUS_ARRAY,IERR)
            IF(IERR.NE.MPI_SUCCESS) 
     $           CALL WRNDIE(-4,'<PGRPIN>','MPI WAITALL ERROR')
C
         ENDIF
         INTVCN=INTVCN+1
      ELSE IF(IPMGRP.EQ.1) THEN
         IF(INTVCN.LT.INTVMX) THEN
            B='Y'
            TYPE=1
            LENGTH=1
            NODE=MYNOD
            CALL MPI_ISEND(B,LENGTH,MPI_BYTE,NODE,TYPE,
     $           MPI_COMM_WORLD,REQ(1),IERR)
            IF(IERR.NE.MPI_SUCCESS) 
     @           CALL WRNDIE(-4,'<PGRPIN>','MPI ISEND ERROR')
            LENGTH=1
            NODE=MYNOD
            CALL MPI_IRECV(B,LENGTH,MPI_BYTE,NODE,TYPE,
     $           MPI_COMM_WORLD,REQ(2),IERR)
            IF(IERR.NE.MPI_SUCCESS) 
     $           CALL WRNDIE(-4,'<PGRPIN>','MPI IRECV ERROR')
            LENGTH=2
            CALL MPI_WAITALL(LENGTH,REQ,STATUS_ARRAY,IERR)
            IF(IERR.NE.MPI_SUCCESS) 
     $           CALL WRNDIE(-4,'<PGRPIN>','MPI WAITALL ERROR')
         ENDIF
C
         INTVCN=INTVCN+1
      ELSE
         CALL WRNDIE(-5,'<PGRPIN>',
     $        'Interleaving supported only for CONCUR = 2.')
      ENDIF
C
##ENDIF
      RETURN
      END
C
##ENDIF
C
      INTEGER FUNCTION NPTWO()
C-----------------------------------------------------------------------
##INCLUDE '~/charmm_fcm/impnon.fcm'
C
C     Returns log_2(NNOD()). This is LOCAL!!!
C
##IF T3D T3E
      nptwo = log2npes()
##ELSE
      INTEGER I, ND, LNNOD
      EXTERNAL LNNOD
C
      I=LNNOD()
      ND=-1
 10   ND=ND+1
      I=I/2
      IF(I.GT.0)GOTO 10
      NPTWO=ND
##ENDIF
      RETURN
##ENDIF ! PARALLEL
      END
