c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine readpdb  --  input of Protein Data Bank file  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "readpdb" gets a set of Protein Data Bank coordinates
c     from an external disk file
c
c
      subroutine readpdb (ipdb)
      implicit none
      include 'sizes.i'
      include 'files.i'
      include 'iounit.i'
      include 'pdb.i'
      include 'sequen.i'
      include 'titles.i'
      integer i,ipdb,next,resnumb
      integer index,trimtext
      integer nalt,nins,length
      integer serial,residue,reslast
      real*8 xx,yy,zz
      character*1 altloc,altsym,altlast
      character*1 chain,chainsym,chnlast
      character*1 insert,inslast
      character*1 letter,chnatm(maxatm)
      character*3 resname,namelast
      character*4 atmname,word
      character*6 remark
      character*20 alttyp,chaintyp
      character*20 instyp,instemp
      character*60 pdbfile
      character*80 record,string
      logical exist,opened,model
      intrinsic index
c
c
c     open the input file if it has not already been done
c
      inquire (unit=ipdb,opened=opened)
      if (.not. opened) then
         pdbfile = filename(1:leng)//'.pdb'
         call version (pdbfile,'old')
         inquire (file=pdbfile,exist=exist)
         if (exist) then
            open (unit=ipdb,file=pdbfile,status='old')
            rewind (unit=ipdb)
         else
            write (iout,10)
   10       format (/,' READPDB  --  Unable to Brookhaven Protein',
     &                 ' Databank File')
            call fatal
         end if
      end if
c
c     initialize the model flag, residue counter and residue name
c
      model = .false.
      resnumb = 0
      reslast = 0
      namelast = '   '
c
c     initialize lists of alternate sites, chains and insertions
c
      nalt = 0
      nchain = 0
      nins = 0
      altlast = '#'
      chnlast = '#'
      inslast = '#'
      alttyp = '                    '
      chaintyp = '####################'
      instyp = '                    '
c
c     extract header information from the Protein Data Bank file
c
      dowhile (.true.)
         read (ipdb,20,end=30) record
   20    format (a80)
         call upcase (record)
         remark = record(1:6)
         if (remark .eq. 'HEADER') then
            title = record(11:70)
            ltitle = trimtext (title)
            goto 30
         end if
      end do
   30 continue
c
c     scan for alternate locations, multiple chains and inserts
c
      rewind (unit=ipdb)
      dowhile (.true.)
         read (ipdb,40,end=60)  record
   40    format (a80)
         call upcase (record)
         remark = record(1:6)
         string = record(7:80)
         if (remark.eq.'ATOM  ' .or. remark.eq.'HETATM') then
            read (string,50)  altloc,chain,insert
   50       format (10x,a1,4x,a1,4x,a1)
            if (altloc .ne. altlast) then
               if (index(alttyp,altloc) .eq. 0) then
                  nalt = nalt + 1
                  alttyp(nalt:nalt) = altloc
                  altlast = altloc
               end if
            end if
            if (chain .ne. chnlast) then
               if (index(chaintyp,chain) .eq. 0) then
                  nchain = nchain + 1
                  chaintyp(nchain:nchain) = chain
                  chnlast = chain
               end if
            end if
            if (insert .ne. inslast) then
               if (index(instyp,insert) .eq. 0) then
                  nins = nins + 1
                  instyp(nins:nins) = insert
                  inslast = insert
               end if
            end if
         end if
      end do
   60 continue
c
c     find out which set of alternate locations will be used
c
      altsym = ' '
      if (nalt .gt. 0) then
         string(1:3) = '['//alttyp(1:1)//']'
         length = 3
         do i = 2, nalt
            string = string(1:length)//' '//alttyp(i:i)
            length = length + 2
         end do
         write (iout,70)  string(1:length)
   70    format (/,' Choose a Set of Alternate Atom Locations',
     &              ' from (',a,') :  ',$)
         read (input,80)  altsym
   80    format (a1)
         if (altsym .eq. ' ')  altsym = alttyp(1:1)
         call upcase (altsym)
      end if
c
c     find out which, if any, insert records will be used
c
      if (nins .gt. 0) then
         instemp = '                    '
         string(1:1) = instyp(1:1)
         length = 1
         do i = 2, nins
            string = string(1:length)//' '//instyp(i:i)
            length = length + 2
         end do
         string = string(1:length)//' [ALL] NONE'
         length = length + 11
         write (iout,90)  string(1:length)
   90    format (/,' Enter the Insert Records to include',
     &              ' (',a,') :  ',$)
         read (input,100)  instemp
  100    format (a20)
         call upcase (instemp)
         next = 1
         call getword (instemp,word,next)
         if (word.eq.'    ' .or. word.eq.'ALL ') then
            continue
         else if (word .eq. 'NONE') then
            instyp = '                    '
         else
            instyp = instemp
         end if
      end if
c
c     process every atom of each chain from the Protein Data Bank file
c
      do i = 1, nchain
         rewind (unit=ipdb)
         chainsym = chaintyp(i:i)
         dowhile (.true.)
            read (ipdb,110,end=170) record
  110       format (a80)
            call upcase (record)
            remark = record(1:6)
            if (remark .eq. 'ATOM  ') then
               string = record(7:80)
               read (string,120)  serial,atmname,altloc,resname,
     &                            chain,residue,insert,xx,yy,zz
  120          format (i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,3f8.3)
               if (residue .le. 0)  goto 130
               if (chain .ne. chainsym)  goto 130
               if (altloc.ne.' ' .and. altloc.ne.altsym)  goto 130
               if (insert.ne.' ' .and. index(instyp,insert).eq.0)
     &            goto 130
               if (residue.ne.reslast .or. resname.ne.namelast
     &                     .or. insert.ne.inslast) then
                  resnumb = resnumb + 1
                  reslast = residue
                  namelast = resname
                  inslast = insert
               end if
               call fixpdb (resname,atmname)
               npdb = npdb + 1
               xpdb(npdb) = xx
               ypdb(npdb) = yy
               zpdb(npdb) = zz
               pdbtyp(npdb) = remark
               atmnam(npdb) = atmname
               resnam(npdb) = resname
               resnum(npdb) = resnumb
               chnatm(npdb) = chain
  130          continue
            else if (remark .eq. 'HETATM') then
               string = record(7:80)
               read (string,140)  serial,atmname,altloc,resname,
     &                            chain,residue,insert,xx,yy,zz
  140          format (i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,3f8.3)
               if (chain .ne. chainsym)  goto 150
               if (altloc.ne.' ' .and. altloc.ne.altsym)  goto 150
               if (insert.ne.' ' .and. index(instyp,insert).eq.0)
     &            goto 150
               call fixpdb (resname,atmname)
               npdb = npdb + 1
               xpdb(npdb) = xx
               ypdb(npdb) = yy
               zpdb(npdb) = zz
               pdbtyp(npdb) = remark
               atmnam(npdb) = atmname
               resnam(npdb) = resname
               resnum(npdb) = 0
               chnatm(npdb) = chain
  150          continue
            else if (remark .eq. 'MODEL ') then
               if (model) then
                  write (iout,160)
  160             format (/,' READPDB  --  File contains Multiple',
     &                       ' Models; First one Used')
                  goto 170
               else
                  model = .true.
               end if
            end if
         end do
  170    continue
      end do
c
c     set the total sequence length and chain termini information
c
      nseq = npdb
      nchain = 0
      chnlast = '#'
      do i = 1, npdb
         if (pdbtyp(i) .eq. 'ATOM  ') then
            letter = chnatm(i)
            if (letter .ne. chnlast) then
               nchain = nchain + 1
               ichain(1,nchain) = resnum(i)
               chnnam(nchain) = letter
               chnlast = letter
            else
               ichain(2,nchain) = resnum(i)
            end if
         end if
      end do
      if (.not. opened)  close (unit=ipdb)
      return
      end
c
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine fixpdb  --  correct nonstandard PDB atom names  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "fixpdb" corrects problems with the AMBER and CHARMM/XPLOR
c     PDB files by converting atom names to the PDB standards
c
c
      subroutine fixpdb (resname,atmname)
      implicit none
      character*3 resname
      character*4 atmname
c
c
c     convert any unusual atom names in terminal residues
c
      if (atmname .eq. ' HN ')  atmname = ' H  '
      if (atmname .eq. ' HT1')  atmname = '1H  '
      if (atmname .eq. ' HN1')  atmname = '1H  '
      if (atmname .eq. ' HT2')  atmname = '2H  '
      if (atmname .eq. ' HN2')  atmname = '2H  '
      if (atmname .eq. ' HT3')  atmname = '3H  '
      if (atmname .eq. ' HN3')  atmname = '3H  '
      if (atmname .eq. ' OT1')  atmname = ' O  '
      if (atmname .eq. 'OCT1')  atmname = ' O  '
      if (atmname .eq. ' OT ')  atmname = ' OXT'
      if (atmname .eq. ' OT2')  atmname = ' OXT'
      if (atmname .eq. 'OCT2')  atmname = ' OXT'
c
c     glycine residue  (GLY)
c
      if (resname .eq. 'GLY') then
         if (atmname .eq. ' HA1')  atmname = '1HA '
         if (atmname .eq. ' HA2')  atmname = '2HA '
c
c     alanine residue  (ALA)
c
      else if (resname .eq. 'ALA') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HB3')  atmname = '3HB '
c
c     valine residue  (VAL)
c
      else if (resname .eq. 'VAL') then
         if (atmname .eq. 'HG11')  atmname = '1HG1'
         if (atmname .eq. 'HG12')  atmname = '2HG1'
         if (atmname .eq. 'HG13')  atmname = '3HG1'
         if (atmname .eq. 'HG21')  atmname = '1HG2'
         if (atmname .eq. 'HG22')  atmname = '2HG2'
         if (atmname .eq. 'HG23')  atmname = '3HG2'
c
c     leucine residue  (LEU)
c
      else if (resname .eq. 'LEU') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. 'HD11')  atmname = '1HD1'
         if (atmname .eq. 'HD12')  atmname = '2HD1'
         if (atmname .eq. 'HD13')  atmname = '3HD1'
         if (atmname .eq. 'HD21')  atmname = '1HD2'
         if (atmname .eq. 'HD22')  atmname = '2HD2'
         if (atmname .eq. 'HD23')  atmname = '3HD2'
c
c     isoleucine residue  (ILE)
c
      else if (resname .eq. 'ILE') then
         if (atmname .eq. ' CD ')  atmname = ' CD1'
         if (atmname .eq. 'HG11')  atmname = '1HG1'
         if (atmname .eq. 'HG12')  atmname = '2HG1'
         if (atmname .eq. 'HG21')  atmname = '1HG2'
         if (atmname .eq. 'HG22')  atmname = '2HG2'
         if (atmname .eq. 'HG23')  atmname = '3HG2'
         if (atmname .eq. 'HD11')  atmname = '1HD1'
         if (atmname .eq. ' HD1')  atmname = '1HD1'
         if (atmname .eq. 'HD12')  atmname = '2HD1'
         if (atmname .eq. ' HD2')  atmname = '2HD1'
         if (atmname .eq. 'HD13')  atmname = '3HD1'
         if (atmname .eq. ' HD3')  atmname = '3HD1'
c
c     serine residue  (SER)
c
      else if (resname .eq. 'SER') then
         if (atmname .eq. ' OG1')  atmname = ' OG '
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = ' HG '
         if (atmname .eq. ' HOG')  atmname = ' HG '
c
c     threonine residue  (THR)
c
      else if (resname .eq. 'THR') then
         if (atmname .eq. ' OG ')  atmname = ' OG1'
         if (atmname .eq. ' CG ')  atmname = ' CG2'
         if (atmname .eq. ' HOG')  atmname = ' HG1'
         if (atmname .eq. 'HG21')  atmname = '1HG2'
         if (atmname .eq. 'HG22')  atmname = '2HG2'
         if (atmname .eq. 'HG23')  atmname = '3HG2'
c
c     cysteine residue  (CYS)
c
      else if (resname .eq. 'CYS') then
         if (atmname .eq. ' SG1')  atmname = ' SG '
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = ' HG '
         if (atmname .eq. ' HSG')  atmname = ' HG '
c
c     proline residue  (PRO)
c
      else if (resname .eq. 'PRO') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
         if (atmname .eq. ' HD1')  atmname = '1HD '
         if (atmname .eq. ' HD2')  atmname = '2HD '
c
c     phenylalanine residue  (PHE)
c
      else if (resname .eq. 'PHE') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
c
c     tyrosine residue  (TYR)
c
      else if (resname .eq. 'TYR') then
         if (atmname .eq. ' HOH')  atmname = ' HH '
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
c
c     tryptophan residue  (TRP)
c
      else if (resname .eq. 'TRP') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HNE')  atmname = ' HE1'
c
c     histidine residue  (HIS)
c
      else if (resname .eq. 'HIS') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HND')  atmname = ' HD1'
         if (atmname .eq. ' HNE')  atmname = ' HE2'
c
c     aspartic acid residue  (ASP)
c
      else if (resname .eq. 'ASP') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
c
c     asparagine residue  (ASN)
c
      else if (resname .eq. 'ASN') then
         if (atmname .eq. ' OD ')  atmname = ' OD1'
         if (atmname .eq. ' ND ')  atmname = ' ND2'
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. 'HD21')  atmname = '1HD2'
         if (atmname .eq. 'HND1')  atmname = '1HD2'
         if (atmname .eq. 'HD22')  atmname = '2HD2'
         if (atmname .eq. 'HND2')  atmname = '2HD2'
c
c     glutamic acid residue  (GLU)
c
      else if (resname .eq. 'GLU') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
c
c     glutamine residue  (GLN)
c
      else if (resname .eq. 'GLN') then
         if (atmname .eq. ' OE ')  atmname = ' OE1'
         if (atmname .eq. ' NE ')  atmname = ' NE2'
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
         if (atmname .eq. 'HE21')  atmname = '1HE2'
         if (atmname .eq. 'HNE1')  atmname = '1HE2'
         if (atmname .eq. 'HE22')  atmname = '2HE2'
         if (atmname .eq. 'HNE2')  atmname = '2HE2'
c
c     methionine residue  (MET)
c
      else if (resname .eq. 'MET') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
         if (atmname .eq. ' HE1')  atmname = '1HE '
         if (atmname .eq. ' HE2')  atmname = '2HE '
         if (atmname .eq. ' HE3')  atmname = '3HE '
c
c     lysine residue  (LYS)
c
      else if (resname .eq. 'LYS') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
         if (atmname .eq. ' HD1')  atmname = '1HD '
         if (atmname .eq. ' HD2')  atmname = '2HD '
         if (atmname .eq. ' HE1')  atmname = '1HE '
         if (atmname .eq. ' HE2')  atmname = '2HE '
         if (atmname .eq. ' HZ1')  atmname = '1HZ '
         if (atmname .eq. 'HNZ1')  atmname = '1HZ '
         if (atmname .eq. ' HZ2')  atmname = '2HZ '
         if (atmname .eq. 'HNZ2')  atmname = '2HZ '
         if (atmname .eq. ' HZ3')  atmname = '3HZ '
         if (atmname .eq. 'HNZ3')  atmname = '3HZ '
c
c     arginine residue  (ARG)
c
      else if (resname .eq. 'ARG') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
         if (atmname .eq. ' HD1')  atmname = '1HD '
         if (atmname .eq. ' HD2')  atmname = '2HD '
         if (atmname .eq. 'HH11')  atmname = '1HH1'
         if (atmname .eq. 'HN11')  atmname = '1HH1'
         if (atmname .eq. 'HH12')  atmname = '2HH1'
         if (atmname .eq. 'HN12')  atmname = '2HH1'
         if (atmname .eq. 'HH21')  atmname = '1HH2'
         if (atmname .eq. 'HN21')  atmname = '1HH2'
         if (atmname .eq. 'HH22')  atmname = '2HH2'
         if (atmname .eq. 'HN22')  atmname = '2HH2'
c
c     ornithine residue  (ORN)
c
      else if (resname .eq. 'ORN') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
         if (atmname .eq. ' HD1')  atmname = '1HD '
         if (atmname .eq. ' HD2')  atmname = '2HD '
         if (atmname .eq. ' HE1')  atmname = '1HE '
         if (atmname .eq. 'HNE1')  atmname = '1HE '
         if (atmname .eq. ' HE2')  atmname = '2HE '
         if (atmname .eq. 'HNE2')  atmname = '2HE '
         if (atmname .eq. ' HE3')  atmname = '3HE '
         if (atmname .eq. 'HNE3')  atmname = '3HE '
c
c     methylalanine residue  (AIB)
c
      else if (resname .eq. 'AIB') then
         if (atmname .eq. 'HB11')  atmname = '1HB1'
         if (atmname .eq. 'HB12')  atmname = '2HB1'
         if (atmname .eq. 'HB13')  atmname = '3HB1'
         if (atmname .eq. 'HB21')  atmname = '1HB2'
         if (atmname .eq. 'HB22')  atmname = '2HB2'
         if (atmname .eq. 'HB23')  atmname = '3HB2'
c
c     pyroglutamic acid residue  (PCA)
c
      else if (resname .eq. 'PCA') then
         if (atmname .eq. ' HB1')  atmname = '1HB '
         if (atmname .eq. ' HB2')  atmname = '2HB '
         if (atmname .eq. ' HG1')  atmname = '1HG '
         if (atmname .eq. ' HG2')  atmname = '2HG '
      end if
      return
      end
