CHARMM Element source/gamint/ddi.src $Revision: 1.2 $
##IF GAMESS (gamess)
##IF PARALLEL
C
C     Distributed Data Interface (DDI)
C     ==========================
C
C     The DDI library is used by parallel GAMESS.
C     The implementation in GAMESS uses 2 threads per CPU,
C     and client-server model which CANNOT be made compatible 
C     with CHARMM parallel library. The new library was needed.
C     This is the implementation of DDI API with the CHARMM
C     parallel communication routines.
C
C     There is also efficiency argument: Original DDI uses direct
C     MPI global communication routines (MPI_ALLREDUCE,...) while
C     CHARMM implementation of these (##CMPI) is usually faster.
C
C     Written in June 2000 by Milan Hodoscek
C
C     Status: All the routines needed for standard GAMESS 
C             (functionality of versions before year 2000) are
C             implemented. The new mp2ddi is not supported yet.
C
C
C     Subroutines in this file:
C     =========================
C     DDI_PBEG(NWDVAR)                      INITIALIZE DDI PARAMETERS
C     DDI_PEND(ISTAT)                       MAKE TIDY EXIT
C     DDI_NPROC(DDI_NP,DDI_ME)              NUMBER OF NODES AND NODE ID
C [*] DDI_MEMORY(MEMREP,MEMDDI,EXETYP)      ALLOCATE SHARED MEMORY REGION
C [*] DDI_CREATE(IDIM,JDIM,HANDLE)          CREATE DISTRIBUTED MATRIX
C [*] DDI_DESTROY(HANDLE)                   DESTROY DISTRIBUTED MATRIX
C [*] DDI_DISTRIB(HANDLE,NODE,ILOC,IHIC,JLOC,JHIC)  QUERY DM DISTRIBUTION
C [*] DDI_DLBRESET                          RESET DLB TASK COUNTER
C     DDI_SYNC(SNCTAG)                      BARRIER SYNCHRONIZATION
C     DDI_GSUMF(MSGTAG,BUFF,MSGLEN)         FLOATING POINT GLOBAL SUM
C     DDI_GSUMI(MSGTAG,BUFF,MSGLEN)         INTEGER GLOBAL SUM
C     DDI_BCAST(MSGTAG,TYPE,BUFF,LEN,FROM)  BROADCAST DATA TO ALL NODES
C    
C                         POINT-TO-POINT TASKS
C     DDI_SEND(SNDBUF,LEN,TO)               SYNCHRONOUS SEND
C     DDI_RECV(RCVBUF,LEN,FROM)             SYNCHRONOUS RECEIVE
C [*] DDI_RCVANY(RCVBUF,LEN,FROM)           SYNCHRONOUS RECEIVE FROM ANY
C [*] DDI_DLBNEXT(DLB_COUNTER)              GET NEXT DLB TASK INDEX
C [*] DDI_GET(HANDLE,ILO,IHI,JLO,JHI,BUFF)  GET BLOCK OF MATRIX
C [*] DDI_PUT(HANDLE,ILO,IHI,JLO,JHI,BUFF)  PUT BLOCK OF MATRIX
C [*] DDI_ACC(HANDLE,ILO,IHI,JLO,JHI,BUFF)  ACCUMULATE DATA INTO BLOCK 
C
C     As of June 2000 the routines noted by [*] are empty.
C
      SUBROUTINE DDI_PBEG(NWDVAR)
C-----------------------------------------------------------------------
C
C     This is empty routine since CHARMM already did the job
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER NWDVAR
C
      RETURN
      END
C
      SUBROUTINE DDI_PEND(ISTAT)
C-----------------------------------------------------------------------
C
C     This is empty routine since CHARMM will take care of it
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER ISTAT
C
      RETURN
      END
C
      SUBROUTINE DDI_NPROC(DDI_NP,DDI_ME)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER DDI_NP, DDI_ME, MNOD, NNOD
      EXTERNAL MNOD, NNOD
C
      DDI_ME = MNOD()
      DDI_NP = NNOD()
C
      RETURN
      END
C
      SUBROUTINE DDI_MEMORY(MEMREP,MEMDDI,EXETYP)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER MEMREP, MEMDDI
      REAL*8 EXETYP
C
C     We don't want these print messages
C
CCC      IF(PRNLEV.GE.2)
CCC     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_MEMORY not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_CREATE(IDIM,JDIM,HANDLE)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER IDIM,JDIM,HANDLE
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_CREATE not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_DESTROY(HANDLE)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER HANDLE
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_DESTROY not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_DISTRIB(HANDLE,NODE,ILOC,IHIC,JLOC,JHIC)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER HANDLE,NODE, ILOC, IHIC, JLOC, JHIC
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_DISTRIB not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_DLBRESET
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      WRITE(OUTU,'(A)')'%%%-DDI: DDI_DLBRESET not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_SYNC(SNCTAG)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER SNCTAG
C
      CALL PSYNC()
C
      RETURN
      END
C
      SUBROUTINE DDI_GSUMF(MSGTAG,BUFF,MSGLEN)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
C
      INTEGER MSGTAG,MSGLEN
      REAL*8 BUFF
C
      CALL GCOMB(BUFF,MSGLEN)
C
      RETURN
      END
C
      SUBROUTINE DDI_GSUMI(MSGTAG,BUFF,MSGLEN)
C-----------------------------------------------------------------------
C
C     This routine has no equivalent in the CHARMM.
C     It is now implemented only for MPI. Any non MPI
C     based parallel computer will not be able to compile
C     this module.
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stack.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER MSGTAG,BUFF,MSGLEN
C
      INCLUDE 'mpi/mpif.h'
C
##IF GNUALPHA
      INTEGER W
      INTEGER*4 STATUS,MMSGLEN
C
C Under Alpha Linux, the array is of INTEGER*8, so double the length
C for MPI_INTEGER (which is INTEGER*4)
      MMSGLEN=2*MSGLEN
      W=ALLSTK(INTEG4(MSGLEN))
      CALL MPI_ALLREDUCE(BUFF,STACK(W),MMSGLEN,MPI_INTEGER,MPI_SUM,
     @                   MPI_COMM_WORLD,STATUS)
      CALL COPYI4(STACK(W),BUFF,MSGLEN)
      CALL FRESTK(INTEG4(MSGLEN))
##ELSE
      INTEGER W,STATUS
C
      W=ALLSTK(INTEG4(MSGLEN))
      CALL MPI_ALLREDUCE(BUFF,STACK(W),MSGLEN,MPI_INTEGER,MPI_SUM,
     @                   MPI_COMM_WORLD,STATUS)
      CALL COPYI4(STACK(W),BUFF,MSGLEN)
      CALL FRESTK(INTEG4(MSGLEN))
##ENDIF
C
      RETURN
      END
C
      SUBROUTINE DDI_BCAST(MSGTAG,TYPE,BUFF,LEN,FROM)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER MSGTAG, BUFF(*), LEN, FROM
      CHARACTER*1 TYPE
C
      IF(FROM.NE.0) THEN
         WRITE(OUTU,'(A)')
     $        '%%%-DDI::DDI_BCAST>broadcast from non 0 not implemented.'
         CALL WRNDIE(-5,'<DDI_BCAST>','Not implemented yet.')
      ENDIF
      IF (TYPE.EQ.'F') THEN
         CALL PSND8(BUFF,LEN)
      ELSE IF (TYPE.EQ.'I') THEN
         CALL PSND4(BUFF,LEN)
      ELSE
         CALL WRNDIE(-5,'<DDI_BCAST>','Type not supported.')
      ENDIF         
C
      RETURN
      END
C                
      SUBROUTINE DDI_SEND(SNDBUF,LEN,TO)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER LEN,TO
      REAL*8 SNDBUF(*)
C
      CALL GSEN(TO,1,SNDBUF,8*LEN)
C
      RETURN
      END
C
      SUBROUTINE DDI_RECV(RCVBUF,LEN,FROM)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER LEN,FROM
      REAL*8 RCVBUF(*)
C
      CALL GREC(FROM,1,RCVBUF,8*LEN)
C
      RETURN
      END
C
      SUBROUTINE DDI_RCVANY(RCVBUF,LEN,FROM)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER LEN,FROM,RCVBUF(*)
C
      IF(PRNLEV.GE.2)
     $           WRITE(OUTU,'(A)')'%%%-DDI: DDI_RCVANY not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_DLBNEXT(DLB_COUNTER)
C-----------------------------------------------------------------------
C
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER DLB_COUNTER
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_DLBNEXT not implemented.'
C
      return
      end
C
      SUBROUTINE DDI_GET(HANDLE,ILO,IHI,JLO,JHI,BUFF)
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER HANDLE,ILO,IHI,JLO,JHI
      REAL*8 BUFF(*)
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_GET not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_PUT(HANDLE,ILO,IHI,JLO,JHI,BUFF)
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER HANDLE,ILO,IHI,JLO,JHI
      REAL*8 BUFF(*)
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_PUT not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_ACC(HANDLE,ILO,IHI,JLO,JHI,BUFF)
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      INTEGER HANDLE,ILO,IHI,JLO,JHI
      REAL*8 BUFF(*)
C
      IF(PRNLEV.GE.2)
     $     WRITE(OUTU,'(A)')'%%%-DDI: DDI_ACC not implemented.'
C
      RETURN
      END
C
      SUBROUTINE DDI_LEVEL(L)
##INCLUDE '~/charmm_fcm/impnon.fcm'
##INCLUDE '~/charmm_fcm/exfunc.fcm'
##INCLUDE '~/charmm_fcm/stream.fcm'
C
      LOGICAL L
      L=.TRUE.
C
##ELSE
      SUBROUTINE DDI_PBEG(NWDVAR)
      RETURN
      END
      SUBROUTINE DDI_PEND(ISTAT)
      RETURN
      END
      SUBROUTINE DDI_NPROC(DDI_NP,DDI_ME)
      RETURN
      END
      SUBROUTINE DDI_MEMORY(MEMREP,MEMDDI,EXETYP)
      RETURN
      END
      SUBROUTINE DDI_CREATE(IDIM,JDIM,HANDLE)
      RETURN
      END
      SUBROUTINE DDI_DESTROY(HANDLE)
      RETURN
      END
      SUBROUTINE DDI_DISTRIB(HANDLE,NODE,ILOC,IHIC,JLOC,JHIC)
      RETURN
      END
      SUBROUTINE DDI_DLBRESET
      RETURN
      END
      SUBROUTINE DDI_SYNC(SNCTAG)
      RETURN
      END
      SUBROUTINE DDI_GSUMF(MSGTAG,BUFF,MSGLEN)
      RETURN
      END
      SUBROUTINE DDI_GSUMI(MSGTAG,BUFF,MSGLEN)
      RETURN
      END
      SUBROUTINE DDI_BCAST(MSGTAG,TYPE,BUFF,LEN,FROM)
      RETURN
      END
C                
      SUBROUTINE DDI_SEND(SNDBUF,LEN,TO)
      RETURN
      END
      SUBROUTINE DDI_RECV(RCVBUF,LEN,TO)
      RETURN
      END
      SUBROUTINE DDI_RCVANY(RCVBUF,LEN,TO)
      RETURN
      END
      SUBROUTINE DDI_DLBNEXT(DLB_COUNTER)
      RETURN
      END
      SUBROUTINE DDI_GET(HANDLE,ILO,IHI,JLO,JHI,BUFF)
      RETURN
      END
      SUBROUTINE DDI_PUT(HANDLE,ILO,IHI,JLO,JHI,BUFF)
      RETURN
      END
      SUBROUTINE DDI_ACC(HANDLE,ILO,IHI,JLO,JHI,BUFF)
      RETURN
      END
      SUBROUTINE DDI_LEVEL(L)
##ENDIF
##ELSE  (gamess)
      SUBROUTINE NULL_DDI
C
##ENDIF (gamess)
C
      RETURN
      END
