C  5 JUL 05 - MWS - SELECT NEW ATOM,BASIS,EFP,PCM,DAF DIMENSIONS
C 30 APR 05 - DGF - SYNCHRONISE SYMBLK COMMON GDDI
C 19 MAY 04 - DGF - GAMESS-SPECIFIC INTERFACE WITH DDI ROUTINES
C
C*MODULE DDILIB   *DECK DDI_NSUMI
      SUBROUTINE DDI_NSUMI(MSGTAG, INT1, INT2, INT3, INT4, MSGLEN)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (NBUF=4)
      INTEGER IBUF(NBUF)
C
C     SUM UP TO 4 INTEGERS IN ONE DDI_GSUMI
C
      IF(MSGLEN.GT.NBUF) CALL ABRT
C
C
      IF(MSGLEN.GE.1) IBUF(1)=INT1
      IF(MSGLEN.GE.2) IBUF(2)=INT2
      IF(MSGLEN.GE.3) IBUF(3)=INT3
      IF(MSGLEN.GE.4) IBUF(4)=INT4
C
      CALL DDI_GSUMI(MSGTAG,IBUF,MSGLEN)
C
      IF(MSGLEN.GE.1) INT1=IBUF(1)
      IF(MSGLEN.GE.2) INT2=IBUF(2)
      IF(MSGLEN.GE.3) INT3=IBUF(3)
      IF(MSGLEN.GE.4) INT4=IBUF(4)
C
      RETURN
      END
C*MODULE DDILIB   *DECK GDDI_INIT
      SUBROUTINE GDDI_INIT(NEWNGROUPS,MANNOD)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER DDI_WORLD,DDI_GROUP,MANNOD(0:*)
      LOGICAL ISGDDI,PAROUT
      PARAMETER(DDI_WORLD=0,DDI_GROUP=1)
      COMMON /GDDI/   ISCOPE,NGROUPS,MYGROUP,MEGLOB,NPGLOB,NNGLOB,JBTYP,
     *                ISGDDI,PAROUT
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
C
      WRITE(IW,9000) MEGLOB,NGROUPS,MYGROUP
      CALL GDDI_SCOPE(DDI_WORLD)
      IF(MANNOD(0).LT.0) THEN
        CALL DDI_GROUP_CREATE(NEWNGROUPS)
      ELSE
        CALL DDI_GROUP_CREATE_CUSTOM(NEWNGROUPS,MANNOD)
      ENDIF
      NGROUPS=NEWNGROUPS
      CALL GDDI_SCOPE(DDI_GROUP)
      WRITE(IW,9010) MEGLOB,NGROUPS,MYGROUP
C
      RETURN
 9000 FORMAT(/1X,'GDDI IS ABOUT TO SWITCH GROUPS: ',
     *        'MEGLOB=',I4,' NGROUPS=',I3,' MYGROUP=',I3)
 9010 FORMAT(/1X,'GDDI HAS SWITCHED GROUPS: ',
     *        'MEGLOB=',I4,' NGROUPS=',I3,' MYGROUP=',I3)
      END
C*MODULE DDILIB   *DECK GDDI_MASTID
      SUBROUTINE GDDI_MASTID(MASTID)
      IMPLICIT NONE
      INTEGER DDI_WORLD,DDI_GROUP
      LOGICAL ISGDDI,PAROUT,GOPARR,DSKWRK,MASWRK
      INTEGER ME,MASTER,NPROC,IBTYP,IPTIM
      PARAMETER(DDI_WORLD=0,DDI_GROUP=1)
      COMMON /GDDI/   ISCOPE,NGROUPS,MYGROUP,MEGLOB,NPGLOB,NNGLOB,JBTYP,
     *                ISGDDI,PAROUT
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      INTEGER NGROUPS,MYGROUP,ISCOPE,MEGLOB,NPGLOB,NNGLOB,JBTYP,
     *        MASTID(0:NGROUPS-1),I
C
C     FOR MASTID TO BE FILLED IN PROPERLY THE SCOPE MUST BE DDI_GROUP.
C     MASTID WILL CONTAIN THE GLOBAL ID OF MASTERS.
C
      DO I=0,NGROUPS-1
        MASTID(I)=0
        IF(I.EQ.MYGROUP.AND.ME.EQ.MASTER) MASTID(I)=MEGLOB
      ENDDO
      CALL GDDI_SCOPE(DDI_WORLD)
      CALL DDI_GSUMI( 2900, MASTID, NGROUPS )
      CALL GDDI_SCOPE(DDI_GROUP)
      RETURN
      END
C
C*MODULE DDILIB   *DECK GDDI_CREATE
      SUBROUTINE GDDI_CREATE(N,HANDLE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER HANDLE
C--   INTEGER DDI_ME, DDI_NP, DDI_WORLD,DDI_GROUP
C--   COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
C--   PARAMETER(DDI_WORLD=0,DDI_GROUP=1)
C--   INTEGER MSG(6)
C
*SEQ  RETURN
C
C        AT THE PRESENT TIME THESE FOUR ROUTINES ARE DUMMIED OUT
C        AND THE FMO APPLICATION IS RIGGED SO THAT THEY AREN'T CALLED.
C
      HANDLE = -1
      WRITE(6,900) N,HANDLE
  900 FORMAT(1X,'ERRONEOUSLY CALLED DUMMY GDDI_CREATE: N,HANDLE=',2I4)
      RETURN
C
C     CREATE THE INDEX ARRAY FOR A GDDI DISTRIBUTED MATRIX
C     ON THE DATA SERVER
C     THE MATRIX HAS N ELEMENTS OF VARIABLE SIZE.
C     SHOULD BE CALLED BY EACH NODE.
C     SYNCHRONISATION IS DESCRIBED IN GDDI_DESTROY.
C     THE EASIEST WAY TO DO IT IN THE WORLD SCOPE IN GDDI IS BY
C     SWITCHING WORLD-GROUP.
C
C--      CALL DDI_NPROC( DDI_NP, DDI_ME )
C--      MSG(1) = 11
C--      MSG(2) = N
C--      MSG(3) = 0
C--      MSG(4) = 0
C--      MSG(5) = 0
C--      MSG(6) = 0
C--      NBYTES = 48/NWDVAR
C--      CALL DDI_SEND( MSG, NBYTES, DDI_ME+DDI_NP )
C--      HANDLE=0
C--      CALL GDDI_SCOPE(DDI_WORLD)
C--      CALL GDDI_SCOPE(DDI_GROUP)
C--C     WRITE(6,*) 'CREATED GDDI-DM',HANDLE
C--      RETURN
      END
C
C*MODULE DDILIB   *DECK GDDI_PUT
      SUBROUTINE GDDI_PUT(HANDLE,I,NI,BUF)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER HANDLE
      DOUBLE PRECISION BUF(*)
C--   INTEGER DDI_ME, DDI_NP, TO, MSG(6)
C--   COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
C
*SEQ  RETURN
C
      WRITE(6,900) HANDLE,I,NI,BUF(1)
  900 FORMAT(1X,'ERRONEOUSLY CALLED DUMMY GDDI_PUT: HANDLE=',I4,
     *          ' I=',I4,' NI=',I4,' BUF=',F20.5)
      RETURN
C
C     STORE I-TH ELEMENT OF A GDDI DISTRIB MATRIX ON THE DATA SERVER.
C     THE ELEMENT IS A LINEAR ARRAY OF SIZE NI.
C
C--      CALL DDI_NPROC( DDI_NP, DDI_ME )
C--      MSG(1) = 12
C--      MSG(2) = HANDLE
C--      MSG(3) = I
C--      MSG(4) = NI
C--      MSG(5) = 0
C--      MSG(6) = 0
C--      NBYTES = 48/NWDVAR
C--      TO = DDI_ME+DDI_NP
C--      CALL DDI_SEND( MSG, NBYTES, TO )
C--      CALL DDI_SEND( BUF, NI*8, TO )
C--C     WRITE(6,*) 'PUT GDDI-DM',HANDLE,I, NI, TO
C--      RETURN
      END
C
C*MODULE DDILIB   *DECK GDDI_GET
      SUBROUTINE GDDI_GET(HANDLE,FROM,I,NI,BUF)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER HANDLE,FROM
      DOUBLE PRECISION BUF(*)
C--   INTEGER MSG(6),DDI_WORLD, DDI_GROUP
C--   COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
C--   PARAMETER(DDI_WORLD=0,DDI_GROUP=1)
C
*SEQ  RETURN
C
      WRITE(6,900) HANDLE,FROM,I,NI,BUF(1)
  900 FORMAT(1X,'ERRONEOUSLY CALLED DUMMY GDDI_GET: HANDLE=',I4,
     *          ' FROM=',I4,' I=',I4,' NI=',I4,' BUF=',F20.5)
      RETURN
C
C     GET I-TH ELEMENT OF A GDDI DISTRIBUTED MATRIX. THE ELEMENT
C     IS A LINEAR ARRAY OF SIZE NI. "FROM" TELLS ON WHAT NODE THE DATA
C     IS STORED (FROM IS THE ULTIMATE GLOBAL ID, INCLUDING + DDI_NP).
C
C     CALL DDI_NPROC( DDI_NP, DDI_ME )
C     SWITCH TO THE GLOBAL SCOPE: WE POSSIBLY ASK A DATA SERVER OUTSIDE
C     THE GROUP
C
C--      CALL GDDI_SSCOPE(DDI_WORLD,0)
C--      MSG(1) = 13
C--      MSG(2) = HANDLE
C--      MSG(3) = I
C--      MSG(4) = NI
C--      MSG(5) = 0
C--      MSG(6) = 0
C--      NBYTES = 48/NWDVAR
C--      CALL DDI_SEND( MSG, NBYTES, FROM )
C--      CALL DDI_RECV( BUF, NI*8, FROM )
C--      CALL GDDI_SSCOPE(DDI_GROUP,0)
C--C     WRITE(6,*) 'GOT GDDI-DM',HANDLE,I, NI, FROM
C--      RETURN
      END
C
C*MODULE DDILIB   *DECK GDDI_DESTROY
      SUBROUTINE GDDI_DESTROY(HANDLE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER HANDLE
C--   INTEGER DDI_ME, DDI_NP, MSG(6), DDI_WORLD, DDI_GROUP
C--   COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
C--   PARAMETER(DDI_WORLD=0,DDI_GROUP=1)
C
*SEQ  RETURN
C
      WRITE(6,900) HANDLE
  900 FORMAT(1X,'ERRONEOUSLY CALLED DUMMY GDDI_DESTROY: HANDLE=',I4)
      RETURN
C
C     DESTROY THE INDEX ARRAY FOR A GDDI DISTR. MATR. ON THE DATA SERVER
C     THE MATRIX HAS N ELEMENTS OF VARIABLE SIZE.
C     SHOULD BE CALLED BY EACH NODE.
C     NOTE THAT DDI_SYNC WILL NOT PROPERLY WORK: SYNCHING SHOULD BE DONE
C     IN THE WORLD SCOPE. DEPENDING ON THE RUN OPTIONS, SYNCHING MAY
C     HAVE BEEN DONE (IF GDDI-DLB IS IN EFFECT), BUT WE DO IT AGAIN.
C     SYNCHRONISATION SHOULD BE DONE BEFORE MATRIX DESTRUCTION BUT AFTER
C     MATRIX CREATION, SO THAT THE CODE USING THE MATRICES HAS THEM
C     WORKING SYNCHRONISED. SYNCHRONISATION IS COSTLY BUT OTHERWISE
C     GET/PUT CALLS MAY NOT BE SERVED.
C
C     CALL DDI_SYNC( 10151 )
C
C--      CALL GDDI_SCOPE(DDI_WORLD)
C--      CALL GDDI_SCOPE(DDI_GROUP)
C--      CALL DDI_NPROC( DDI_NP, DDI_ME )
C--      MSG(1) = 14
C--      MSG(2) = HANDLE
C--      MSG(3) = 0
C--      MSG(4) = 0
C--      MSG(5) = 0
C--      MSG(6) = 0
C--      NBYTES = 48/NWDVAR
C--      CALL DDI_SEND( MSG, NBYTES, DDI_ME+DDI_NP )
C--C     WRITE(6,*) 'DESTROYED GDDI-DM',HANDLE
C--      RETURN
C--      END
C
C*MODULE DDILIB   *DECK GDDI_SSCOPE
C--      SUBROUTINE GDDI_SSCOPE(ISCOPE,IMOD)
C--      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C        THIS SHOULD BE ELIMINATED AFTER RYAN DOES ROUTINES ABOVE.
C
C--      WRITE(6,*) 'SOMEHOW IN GDDI_SSCOPE, ITS UNUSED ARG=',IMOD
C--      CALL GDDI_SCOPE(ISCOPE)
C--      RETURN
      END
C
C*MODULE DDILIB   *DECK GDDICOUNT
      SUBROUTINE GDDICOUNT(IMODE,LGROUP,MYJOB)
      IMPLICIT NONE
      INTEGER IMODE,MINE,NEXT,NGROUPS,LGROUP,MYGROUP,ISCOPE,MEGLOB,
     *        NPGLOB,NNGLOB,JBTYP,DDI_WORLD,DDI_GROUP
      PARAMETER(DDI_WORLD=0,DDI_GROUP=1)
      LOGICAL MYJOB,NXT,ISGDDI,PAROUT
      COMMON /GDDI/   ISCOPE,NGROUPS,MYGROUP,MEGLOB,NPGLOB,NNGLOB,JBTYP,
     *                ISGDDI,PAROUT
      SAVE MINE,NEXT
C
C     STATIC AND DYNAMIC LOAD BALANCING BETWEEN GROUPS FOR GDDI.
C     NOTE THAT WORK DIVISION INSIDE A GROUP IS DONE ELSEWHERE.
C     DETERMINE IF THE CURRENT TASK MUST BE DONE BY THIS NODE.
C     BEFORE USAGE CALL WITH IMODE=-1 TO INITIALISE. THEN USE WITH
C     IMODE=0 FOR GETTING JOB STATUS. AFTER USAGE CALL WITH IMODE=1.
C     ON EXIT MYJOB IS TRUE OR FALSE, LGROUP WILL POINT WHAT GROUP WILL
C     DO THIS JOB IF STATIC LOAD BALANCING IS IN EFFECT.
C     HOPEFULLY IT IS UNDERSTOOD THAT CALLS TO GDDICOUNT CAN'T BE NESTED
C     (ONLY ONE LOOP CAN BE DIVIDED INTO GROUPS AT A TIME).
C
      NXT = JBTYP.EQ.1
      IF(ABS(IMODE).EQ.1) THEN
        NEXT = -1
        MINE = -1
        LGROUP=-1
C       NEVER, NEVER ADD .AND. GOPARR TO NXT FOR GDDI!
C       SOME GROUPS MAY HAVE ONE NODE AND GOPARR=.FALSE.
        IF(NXT) THEN
C        ACCORDING TO THE REST OF GAMESS WE CALL DDI_DLBRESET AT THE
C
C        END (NOT AT THE BEGINNING, STRANGE AS IT MAY BE).
C        CHANGING SCOPES TO THE WORLD BACK IS NECESSARY, BECAUSE
C        OTHERWISE SYNCING WILL BE DONE IN THE SAME GROUP, THUS
C        LEADING TO PROCESSES RESETTING AND ASKING FOR DLB OUT OF SYNC.
C
           IF(IMODE.EQ.1) THEN
             CALL GDDI_SCOPE(DDI_WORLD)
             CALL DDI_GDLBRESET()
             CALL GDDI_SCOPE(DDI_GROUP)
           ENDIF
        ENDIF
        MYJOB=.TRUE.
      ELSE
        MINE=MINE+1
        IF(NXT) THEN
C         DYNAMIC LOAD BALANCING
          IF(MINE.GT.NEXT) CALL DDI_GDLBNEXT(NEXT)
C         -1 SHOWS THAT THE GROUP RESPONSIBLE IS UNKNOWN.
          LGROUP=-1
          MYJOB=NEXT.EQ.MINE
        ELSE
C         STATIC LOAD BALANCING
          LGROUP=MOD(MINE,NGROUPS)
          MYJOB=LGROUP.EQ.MYGROUP
        ENDIF
      ENDIF
      RETURN
      END
C
C*MODULE DDILIB   *DECK GDDI_SCOPE
      SUBROUTINE GDDI_SCOPE(NEWSCOPE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      LOGICAL GOPARR,DSKWRK,MASWRK,ISGDDI,PAROUT
      INTEGER DDI_MASTERS
      PARAMETER(DDI_MASTERS=2)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /GDDI/   ISCOPE,NGROUPS,MYGROUP,MEGLOB,NPGLOB,NNGLOB,JBTYP,
     *                ISGDDI,PAROUT
C
      CALL DDI_SCOPE(NEWSCOPE,IMASTER)
      ISCOPE=NEWSCOPE
      CALL DDI_NPROC( NPROC, ME )
      CALL DDI_NGROUP(NGROUP,MYGROUP)
C
C     NGROUPS HAS THE TOTAL NUMBER OF GROUPS,
C     NOT THIS NUMBER WITHIN THE CURRENT SCOPE
C     MASWRK=IMASTER.NE.0
C
      IF(NEWSCOPE.NE.DDI_MASTERS) MASWRK=ME.EQ.MASTER
C     DO NOT REASSIGN MASWRK FOR THE MASTER SCOPE.
      GOPARR=NPROC.GT.1
      RETURN
      END
