C
C $Id: rdsub.F,v 1.4 1998/07/16 16:40:34 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      SUBROUTINE RDSUB(IERROR)
C
C     READS IN THE ATOM LISTS FOR EACH SUBSYSTEM IN THE STRUCTURE.
C     THE ITH LIST IS PRECEDED BY THE CARD 'SUB I', AND THE LAST
C     SUBSYSTEM SHOULD BE FOLLOWED BY THE CARD 'END_SUB'.  WITHIN
C     EACH SUBSYSTEM, A LIST OF CORE ATOMS IS PROVIDED, FOLLOWED BY
C     ATOM LISTS FOR THE INNER AND OUTER BUFFER LAYERS.  FOR EXAMPLE:
C
C                       SUB 1
C                         CORE
C                         3 4 5 6
C                         BUFFER_1
C                         2 7
C                         BUFFER_2
C                         1 8
C                       SUB 2
C                         CORE
C                         7 8 9 10
C                         BUFFER_1
C                         6 11
C                         BUFFER_2
C                         5 12
C                       SUB 3
C                         CORE
C                         11/20
C                         BUFFER_1
C                         10 21
C                         BUFFER_2
C                         9 22
C                         .
C                         .
C                         .
C                       END_SUB
C
C
C     NOTE THAT 11/20 INDICATES THE RANGE OF ATOMS 11 THROUGH 20.
C     THE BUFFER_1 AND BUFFER_2 CARDS NEED TO BE PRESENT, EVEN IF
C     THERE ARE NO BUFFER ATOMS FOR A PARTICULAR SUBSYSTEM.
C
C     NOTE ALSO THAT DUMMY ATOMS AND SPARKLES MAY BE OMITTED FROM THESE
C     LISTS SINCE THEY WILL NOT BE PLACED IN ANY SUBSYSTEM.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"
C
C     LOCAL:
C
      DIMENSION ICORE(MAXATM),IBUFF1(MAXATM),IBUFF2(MAXATM)
      LOGICAL DONE
      CHARACTER LINE*80
C
      IERROR = 0
C
C     NO NEED TO READ ANYTHING IN FOR STANDARD CALCULATION.  JUST ASSIGN
C     A SINGLE SUBSYSTEM ATOM LIST WITH NO BUFFER ATOMS. read file until
C     end_sub is encountered
C
C
      IF(PRTSUB)THEN
C-RDC         WRITE(IOUT,'(//" SUBSYSTEM DEFINITIONS:"
C-RDC      .        /" ---------------------"/)')
      ENDIF
      NSUB = 0
      IPOINT = 1
C
C     READ IN LIST OF CORE ATOMS FOR CURRENT SUBSYSTEM.  CORE ATOM LIST
C     IS FOUND BETWEEN THE 'CORE' AND 'BUFFER_1' DELIMITERS.
C
 100  CALL RDLIST('CORE','BUFFER_1',ICORE,NACORE,DONE,IERROR)
      IF(IERROR.NE.0)THEN
C-RDC         WRITE(IOUT,
C-RDC      .        '(/" IMPROPER SPECIFICATION OF CORE ATOM LIST,",
C-RDC      .                " SUBSYSTEM ",I4)') NSUB+1
        RETURN
      ENDIF
      IF(DONE)THEN
        IF(NSUB.EQ.0)THEN
          IERROR = 1
          WRITE(IOUT,'(/" NO CORE ATOMS DEFINED")')
          RETURN
        ELSE
          GO TO 1000
        ENDIF
      ENDIF
      NSUB = NSUB + 1
      IF(NSUB.EQ.MAXSUB)THEN
        IERROR = 1
        WRITE(IOUT,'(/" MAXIMUM NUMBER OF SUBSYSTEMS REACHED",
     .               /" -- INCREASE MAXSUB PARAMETER IN divcon.dim",
     .                " AND RECOMPILE")')
        RETURN
      ENDIF
C
      IF(NACORE.EQ.0)THEN
        IERROR = 1
        WRITE(IOUT,
     .       '(/" NO CORE ATOMS IN SUBSYSTEM ",I4)') NSUB
        RETURN
      ENDIF
C
C     READ IN ATOMS FOR THE FIRST BUFFER LAYER.  LIST WILL BE FLANKED
C     BY 'BUFFER_1' AND 'BUFFER_2' DELIMITERS.
C
      CALL RDLIST('BUFFER_1','BUFFER_2',IBUFF1,NBUFF1,DONE,IERROR)
      IF(IERROR.NE.0)THEN
        WRITE(IOUT,
     .        '(/" IMPROPER SPECIFICATION OF INNER BUFFER LAYER,",
     .                " SUBSYSTEM ",I4)') NSUB
        RETURN
      ENDIF
      IF(DONE)THEN
        IERROR = 1
        WRITE(IOUT,
     .       '(/" UNEXPECTED ''END_SUB'' DELIMITER FOUND,",
     .                " SUBSYSTEM ",I4)') NSUB
        RETURN
      ENDIF
C
C     READ IN SECOND BUFFER LAYER BETWEEN 'BUFFER_2' AND 'SUB' (OR
C     'END_SUB") DELIMITERS.
C
      CALL RDLIST('BUFFER_2','SUB',IBUFF2,NBUFF2,DONE,IERROR)
      IF(IERROR.NE.0)THEN
         WRITE(IOUT,
     .        '(/" IMPROPER SPECIFICATION OF OUTER BUFFER LAYER,",
     .                " SUBSYSTEM ",I4)') NSUB
        RETURN
      ENDIF
C
C     MAKE SURE WE HAVE ENOUGH SPACE TO STORE THE LATEST ADDITION.
C
      NATOT = NACORE + NBUFF1 + NBUFF2
      IF((IPOINT+NATOT).GE.MSLIST)THEN
        IERROR = 1
        WRITE(IOUT,
     .       '(/" ATOM LIST STORAGE LIMIT REACHED AT SUBSYSTEM",
     .             I4/" -- INCREASE MSLIST PARAMETER IN dicon.dim",
     .                " AND RECOMPILE")') NSUB
        RETURN
      ENDIF
C
C     STORE CORE AND BUFFER ATOMS IN SUBSYSTEM ATOM LIST.  ASSIGN
C     BUFFER STATUS AS WE GO.
C
      IATOM1(NSUB) = IPOINT
      DO 150 I=1,NACORE
        IATOMS(IPOINT) = ICORE(I)
        IABUFF(IPOINT) = 0
        IPOINT = IPOINT + 1
 150  CONTINUE
      IF(NBUFF1.GT.0)THEN
        DO 160 I=1,NBUFF1
          IATOMS(IPOINT) = IBUFF1(I)
          IABUFF(IPOINT) = 1
          IPOINT = IPOINT + 1
 160    CONTINUE
      ENDIF
      IF(NBUFF2.GT.0)THEN
        DO 170 I=1,NBUFF2
          IATOMS(IPOINT) = IBUFF2(I)
          IABUFF(IPOINT) = 2
          IPOINT = IPOINT + 1
 170    CONTINUE
      ENDIF
C
C     SORT ATOM LIST AND CARRY ALONG BUFFER STATUS.
C
      ISTART = IATOM1(NSUB)
      CALL BSORT(NATOT,IATOMS(ISTART),IABUFF(ISTART))
C
C     CHECK FOR DUPLICATE VALUES.
C
      IF(NATOT.GT.1)THEN
        DO 250 I=ISTART+1,IPOINT-1
          IF(IATOMS(I).EQ.IATOMS(I-1))THEN
            IERROR = 1
            WRITE(IOUT,
     .           '(" DUPLICATE ATOM: ",I5,", SUBSYSTEM",
     .                   I4)') IATOMS(I),NSUB
          ENDIF
 250    CONTINUE
        IF(IERROR.NE.0) RETURN
      ENDIF
C
      IF(PRTSUB)THEN
C
C       SUMMARIZE SUBSYSTEM ATOM LIST.
C
C-RDC         WRITE(IOUT,'(/" SUBSYSTEM ",I4,
C-RDC      .               /" --------------",
C-RDC      .               /" CORE ATOMS:")') NSUB
C-RDC         WRITE(IOUT,'(16I5)') (ICORE(I),I=1,NACORE)
        IF(NBUFF1.GT.0)THEN
C-RDC           WRITE(IOUT,'(" INNER BUFFER LAYER:")')
C-RDC           WRITE(IOUT,'(16I5)') (IBUFF1(I),I=1,NBUFF1)
        ENDIF
        IF(NBUFF2.GT.0)THEN
C-RDC           WRITE(IOUT,'(" OUTER BUFFER LAYER:")')
C-RDC           WRITE(IOUT,'(16I5)') (IBUFF2(I),I=1,NBUFF2)
        ENDIF
      ENDIF
C
C     GO BACK AND READ IN ANOTHER SUBSYSTEM.
C
      if (done) goto 1000
      GO TO 100
C
C     SUBSYSTEMS ARE DONE.  STORE FINAL ATOM POINTER IN NSUB+1 SLOT.
C
 1000 IATOM1(NSUB+1) = IPOINT
      RETURN
 2000 write(iout,'(/" UNEXPECTED END-OF-FILE")')
      ierror=1
      return
      END
C
C
C