C
C $Id: rdxyz.F,v 1.4 1998/07/16 16:40:36 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      SUBROUTINE RDXYZ(IERROR)
C
C     READS CARTESIAN COORDINATES AND RELATED INFORAMTION FROM THE MAIN
C     INPUT FILE.  THIS SECTION OF THE INPUT IS TERMINATED BY THE
C     DELIMITER 'END_COORD'.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"
C
C     LOCAL:
C
      CHARACTER CARD*80,ul_list*52
      LOGICAL COORDS
C
C     V.G. - 1/7/99 - upper/lower case list used to convert second letter of
C     atom symbol back to lower case as used in PB solver
      data ul_list(1:26) /'AaBbCcDdEeFfGgHhIiJjKkLlMm'/
      data ul_list(27:52)/'NnOoPpQqRrSsTtUuVvWwXxYyZz'/

      IERROR = 0
      NRES = 0

      COORDS = INDEX(KEYWRD,'PRTCOORDS').NE.0
      IF(COORDS)THEN
C-RDC         WRITE(IOUT,10)
 10     FORMAT(//5X,'ATOM',5X,'ELEMENTAL',12X,'CARTESIAN COORDINATES',
     .         /4X,'NUMBER',5X,'SYMBOL',12X,'X',11X,'Y',11X,'Z'/)
      ENDIF
      I = 0
 100  READ(INPT,110,END=500) CARD
 110  FORMAT(A80)
      CALL UPCASE1(CARD,80)
      IF(INDEX(CARD,'END_COORD').NE.0)THEN
C
C       END OF COORDINATE DATA.  DO SOME CHECKING.
C
        IF(RESDUE)THEN
          IF(NRES.EQ.0)THEN
            IERROR = 1
            WRITE(IOUT,
     .           '(/" ''RESIDUE'' KEYWORD SPECIFIED, BUT NO",
     .                    " RESIDUES WERE DEFINED")')
            RETURN
          ENDIF

C         ADD POINTER FOR NRES+1 FOR CONVENIENCE IN LOOPING.
C
          IRPNT(NRES+1) = NATOMS + 1
        ENDIF
        RETURN
      ENDIF
      I = I+1
      IF(I.EQ.MAXATM)THEN
        IERROR = 1
        WRITE(IOUT,120)
 120    FORMAT(/' MAXIMUM ALLOWED NUMBER OF ATOMS REACHED',
     .         /' -- INCREASE MAXATM PARAMETER IN divcon.dim',
     .          ' AND RECOMPILE')
        RETURN
      ENDIF
      NATOMS = I
C
C     THE FIRST ITEM SHOULD BE THE ATOM NUMBER, WHICH SHOULD BE I.
C
      ISTART = 1
      CALL RDNEXT(CARD,ISTART,ISTOP,ATOM,IERROR)
      IF(IERROR.NE.0) GO TO 600
      IATM = ATOM
      IF(IATM.NE.I)THEN
        IERROR = 1
        WRITE(IOUT,140) I,FNAME(1)
 140    FORMAT(/' USER-SPECIFIED ATOM NUMBER IS INCORRECT FOR ATOMIC',
     .          ' RECORD ',I5,','/' FILE ',A20)
        RETURN
      ENDIF
C
C     EXTRACT ATOMIC SYMBOL AND GET THE CORRESPONDING ATOMIC NUMBER.
C
      ISTART = ISTOP+1
      CALL RDWORD(CARD,ISTART,ISTOP)
      IF(ISTART.EQ.0) GO TO 600
      IF((ISTOP-ISTART).GT.1)THEN
        IERROR = 1
        ISTOP = MIN(ISTOP,ISTART+19)
        WRITE(IOUT,150) (CARD(J:J),J=ISTART,ISTOP)
 150    FORMAT(/' ILLEGAL ELEMENTAL SYMBOL: ',20A1)
        RETURN
      ENDIF
      DO 160 J=0,83
        IF(CARD(ISTART:ISTART+1).EQ.SYMBOL(J))THEN
          IATNUM(I) = J
          GO TO 180
        ENDIF
 160  CONTINUE
      IERROR = 1
      WRITE(IOUT,170) CARD(ISTART:ISTART+1)
 170  FORMAT(/' UNRECOGNIZED ELEMENTAL SYMBOL: ',A2)
      RETURN
C
C     READ X, Y, AND Z COORDINATES.
C
 180  ISTART = ISTOP+1
      DO 200 J=1,3
        CALL RDNEXT(CARD,ISTART,ISTOP,XYZ(J,I),IERROR)
        IF(IERROR.NE.0) GO TO 600
        ISTART = ISTOP+1
 200  CONTINUE

C     Save pdb-like information for PB solver
C     atom info:
C     atom   = 1 :5
C     res    = 7 :10
C     chn    = 11:11
C     rnum   = 12:15
      atom_inf(i)(1:5) = symbol(iatnum(i))
      if(atom_inf(i)(2:2).ne.' ') then
C     .  V.G. - 1/7/99 - Convert to lower case the second letter of atom symbol as
C     .  required by the PB solver
         j = index(ul_list,atom_inf(i)(2:2)) + 1
         atom_inf(i)(2:2) = ul_list(j:j)
      endif
      atom_inf(i)(6:10)  = ' OTH '
      atom_inf(i)(11:15) = '     1'

C
C     LOOK FOR 'RES' FLAG IF USER HAS SPECIFIED A RESIDUE-BASED CALCULATION.
C     'RES' MARKS THE BEGINNING OF THE NEXT RESIDUE.  IT SHOULD BE PLACED
C     SOMEWHERE TOWARD THE END OF THE LINE -- AFTER ALL THE OTHER INFORMATION
C     FOR ATOM I.
C
      IF(RESDUE)THEN
        IF(INDEX(CARD,'RES').NE.0)THEN
          NRES = NRES + 1
          IF(NRES.EQ.MAXRES)THEN
            IERROR = 1
            WRITE(IOUT,
     .           '(/" MAXIMUM ALLOWED NUMBER OF RESIDUES REACHED",
     .         /" -- INCREASE MAXRES PARAMETER IN divcon.dim",
     .          " AND RECOMPILE")')
            RETURN
          ENDIF
          IRPNT(NRES) = I
        ENDIF
      ENDIF
C
C-RDC C     NO ERRORS DETECTED AT THIS POINT, WRITE INFO IF REQUESTED.
C
       IF(COORDS)THEN
         IAT = IATNUM(I)
C-RDC         WRITE(IOUT,300) I,SYMBOL(IAT),(XYZ(J,I),J=1,3)
 300    FORMAT(3X,I5,9X,A2,7X,3(2X,F10.5))
      ENDIF
C
C     GO BACK AND READ ANOTHER LINE OF ATOMIC DATA.
C
      GO TO 100
C
C     END-OF-FILE REACHED IF WE GET TO 500.
C
 500  IERROR = 1
      WRITE(IOUT,510) FNAME(1)
 510  FORMAT(/' TERMINATION DELIMITER ''END_COORD'' MISSING FROM',
     .        ' COORDINATE'/' DATA IN FILE ',A20)
      RETURN
C
C     READ ERROR IF WE GET TO 600
C
 600  IERROR = 1
      WRITE(IOUT,610) I,FNAME(1)
 610  FORMAT(/' ERROR READING INFORMATION FOR ATOM ',I5,
     .         ', FILE ',A20)
      RETURN
      END