      subroutine pdbsiz(iszhnt)
      implicit double precision (a-h,o-z)
      integer iszhnt
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character lstr*137

      call rewfil

      iszhnt = 0
      do while (.true.)
         call nxtlin(lstr,jstat)
         if (jstat.eq.1) goto 20
         if (lstr(1:4).eq."ATOM".or.lstr(1:6).eq."HETATM") 
     &       iszhnt = iszhnt + 1
      end do

20    iszhnt = 3*iszhnt

      return
      end

      subroutine numhed(numhet,iresid)
      implicit double precision (a-h,o-z)
      common /athlp/ iatoms, mxnat
      dimension iresid(*)

      nhmtmp = -3
      do i=1,iatoms
         if (iresid(i).lt.nhmtmp) nhmtmp = iresid(i)
      end do
      numhet = iabs(nhmtmp)

      return
      end

      subroutine pdbtyd(ipdb,ihpdb,jres,ihashy,ipdbt)
      implicit double precision (a-h,o-z)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      dimension ipdb(mxsym), ihpdb(mxhsym*3), ipdbt(*)

      do i=1,mxsym
         it = i
         if (i.eq.70) it = 83
         if (i.eq.71) it = 79
         if (i.eq.72) it = 83
         if (i.eq.73) it = 80
         if (i.eq.74) it = 79
         if (i.eq.75) it = 85
         if (jres.gt.23.and.i.eq.38) it = 76
         if (ipdb(i).gt.0) ipdbt(ipdb(i)) = it
      end do

      if (ihashy.eq.1) then
         do i=1,mxhsym*3
            it = i
            if (i.eq.85) it = 124
            if (i.eq.88) it = 125
            if (i.eq.94) it = 130
            if (i.eq.97) it = 131
            if (i.eq.106) it = 136
            if (i.eq.109) it = 137
            if (ihpdb(i).gt.0) ipdbt(ihpdb(i)) = it
         end do
      endif

      return
      end

      subroutine tocap(line,ncars)
      integer ncars
      character*(*) line

      do i=1,ncars
         j = ichar(line(i:i))
         if (j.ge.97.and.j.le.122) line(i:i) = char(j-32)
      end do

      return
      end

      subroutine tolow(line,ncars)
      integer ncars
      character*(*) line

      do i=1,ncars
         j = ichar(line(i:i))
         if (j.ge.65.and.j.le.90) line(i:i) = char(j+32)
      end do

      return
      end

      character*2 function tocapf(line)
      character*2 line

      tocapf = line

      do i=1,2
         j = ichar(tocapf(i:i))
         if (j.ge.97.and.j.le.122) tocapf(i:i) = char(j-32)
      end do

      return
      end

      subroutine search(line,name,istat)
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character*(*) line,name
      character*137 caps

      istat = 0
      caps  = name  
      len1  = len(name)
      call tocap(caps,len1)
1     call nxtlin(line,jstat)
      if (jstat.eq.1) goto 100
      if (jstat.eq.2) goto 200
      if (index(line,name).eq.0.and.index(line,caps(1:len1)).eq.0)
     &  go to 1
c
      istat=1
      return
100   call rewfil
      return
200   continue
      return
c
c
      end 

      subroutine searchd(line,name1,name2,istat)
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character*(*) line,name1,name2
      character*137 caps1, caps2

      istat = 0
      caps1 = name1
      caps2 = name2
      len1  = len(name1)
      len2  = len(name2)
      call tocap(caps1,len1)
      call tocap(caps2,len2)
1     call nxtlin(line,jstat)
      if (jstat.eq.1.or.jstat.eq.2) goto 100
      if (index(line,name1).eq.0.and.index(line,name2).eq.0
     &.and.index(line,caps1(1:len1)).eq.0
     &.and.index(line,caps2(1:len2)).eq.0) go to 1
c
      istat=1
      return
c
100   call rewfil
c
      return
      end 

      subroutine bcfile()
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      common /rdwr/   iun1,iun2,iun3,iun4,iun5

      backspace iun2

      return
      end

      subroutine connid(idcon,i,j,idoconv,iconn,ianz,coo)
      implicit double precision (a-h,o-z)
      parameter (mxel=100)
      parameter (mxcon=10)
      common /elmcom/ vdwr(mxel),vrad(mxel),icol(mxel)
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      logical coni,conj
      dimension ctemp(3),iconn(mxcon+1,*),ianz(*),coo(3,*)

      toang = 0.52917706d0
      toang2 = toang*toang

      idcon = 0
      coni = .true.
      conj = .true.

      k = iconn(1,i)
      m = iconn(1,j)

      do l=1,k
         if (iconn(1+l,i).eq.j) coni = .false.
      end do

      do l=1,m
         if (iconn(1+l,j).eq.i) conj = .false.
      end do

      if (.not.coni.and..not.conj) return

      dmaxsq = vdwr(ianz(i)) + vdwr(ianz(j))
      dmaxsq = dmaxsq * dmaxsq

      ia = ianz(i)
      ib = ianz(j)
      
      do l=1,3
         ctemp(l) = coo(l,i) - coo(l,j)
      end do

      dijsq = ctemp(1)*ctemp(1) + ctemp(2)*ctemp(2) 
     &             + ctemp(3)*ctemp(3)

      if (idoconv.eq.1) dmaxsq = dmaxsq / toang2

      if (dijsq.lt.dmaxsq) then
          idocon = 1
          k = k + 1
          m = m + 1
          if (k.le.mxcon.and.coni) then
             iconn(1,i) = k
             iconn(k+1,i) = j
          else
             write(iun3,*)'more than mxconn connections found'
          endif
          if (m.le.mxcon.and.conj) then
             iconn(1,j) = m
             iconn(m+1,j) = i
          else
             write(iun3,*)'more than mxconn connections found'
          endif
      endif

      return
      end

      subroutine pdbsdd(istat,doscnd,
     &                  coo,ianz,iaton,iresid,iconn,ityp,
     &                  ncalf,ianf,islu,nchain,iamino,ihet,
     &                  isal,irsnr,achain,ihashb,ishoh)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxamb=1590)
      parameter (mxgff=72)
      parameter (mxamo=201)
      integer doscnd
      character*3 pdbsym,hsym,ambtnk
      character*2 gffstr
      common /symbol/ pdbsym(mxsym),hsym(mxhsym),
     &                ambtnk(mxamb),gffstr(mxgff)
      common /athlp/ iatoms, mxnat
      common /surf / natorg,nosncd

      parameter (numcal=50000)
      parameter (mxres=42)
      parameter (mxheta=150)

      parameter (mxmmul=100)
      character*1 achain
      logical isatm,ishet,hasalt,skip,dall,goods
      character*3 aminos
      common /amino/ aminos(mxres)
      common /multim/imulm, nmulm,ihasqm(mxmmul)
      character*3 hetz
      common /clfstr/ ihashz,ihetq(mxheta),ihqset(mxheta),ihhadd(mxheta)
     &                ,labhet(mxheta),ilcset,ligcat(mxheta),hetz(mxheta)
      character*4 pdbc
      common /pdbcod/ pdbc

      parameter (mxel=100)
      character*2 elemnt
      common /elem/elemnt(mxel)
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character lstr*137
      character*2 tocapf,hetred
      character*4 tstr,tmpstr
      character*3 resi,resit
      character*1 restmp,resa,altloc,aloc,ach,tch,tach
      dimension ipdb(mxsym),hetred(4),
     &          ihpdb(mxhsym*3),tmp(3),isc(numcal)
      dimension coo(3,*),ianz(*),iaton(*),iresid(*),iconn(mxcon+1,*),
     &          ityp(*)
      dimension ianf(*),islu(*),iamino(*),ihet(*),isal(*),irsnr(*),
     &          achain(*)

      data hetred/
     &   'AC','AN','AO','AP'/

      imulm = 1
      call parsfn('Helix',5,1)
      call parsfn('Beta',4,1)
      call parsfn('RNA/DNA',7,1)
      call parsfn('Coil',4,1)
      hetz(1) = 'Hel'
      hetz(2) = 'Bet'
      hetz(3) = 'DNA'
      hetz(4) = 'Coi'

      ihashb = 0

      do i=1,numcal
         isal(i) = 3
         isc(i) = 0
      end do

      noff = 0

      if (doscnd.eq.0) goto 5

      call rewfil
      call search(lstr,'HEADER',istat)
      if (istat.eq.1) then
         pdbc = lstr(63:66)
         call tolow(pdbc,4)
         call parstr(pdbc,11)
      else
         call rewfil
      endif
c
c     Proces Helix/Sheet information
c
      call rewfil

      icnt = 0
      do while (.true.)
          call searchd(lstr,'HELIX','SHEET',istat)
          if (istat.eq.0) goto 5

          if (index(lstr,'HELIX').eq.1) then

             read(lstr,'(19x,1a,1x,i4,8x,i4)',err=4,end=4) tch,i1,i2
             ihashb = 1
             if (noff+i1.gt.numcal) i1 = numcal
             if (noff+i2.gt.numcal) i2 = numcal
             i3 = i2 - i1 + 1
             if (i1.ne.0.and.i3.gt.1) then
                it = ichar(tch)
                if (it.ge.65) it = it - 65
                if (it.eq.32) it = 30
                do i=i1,i2
                   icnt = icnt + 1
                   isc(icnt) = it+0*32+i*128
                end do
             endif

          elseif (index(lstr,'SHEET').eq.1) then

             read(lstr,'(21x,1a,i4,7x,i4)',err=4,end=4) tch,i1,i2
             ihashb = 1
             if (noff+i1.gt.numcal) i1 = numcal
             if (noff+i2.gt.numcal) i2 = numcal
             i3 = i2 - i1 + 1
             if (i1.ne.0.and.i3.gt.1) then
                it = ichar(tch)
                if (it.ge.65) it = it - 65
                if (it.eq.32) it = 30
                do i=i1,i2
                   icnt = icnt + 1
                   isc(icnt) = it+1*32+i*128
                end do
             endif
          endif
      end do

4     print*, 'Error reading HELIX/SHEET record !'
5     continue

      call rewfil
      istat = 1
      hasalt = .false.
      dall = .false.
      
10    call searchd(lstr,'HETATM','ATOM',istat)
      if (istat.eq.0) then
           print*,'no ATOM/HETATM record found !'
           call rewfil
           goto 210
      endif

      if (lstr(1:4).ne.'ATOM'.and.lstr(1:6).ne.'HETATM') goto 10
      call bckfil

      nhmol = 3
      iatoms = 0
      icres = 0
      nchain = 1
      ianf(1) = 1
      islu(1) = 0
      nmulm = 0

      jres = -1
      irtmp = -10000
      ipdb(38) = 0
      restmp = ' '
      tach = ' '
      ihashy = 0
      skip = .false.
      aloc = ' '

      do while (.true.)

15        call nxtlin(lstr,jstat)
          if (jstat.eq.1) goto 20

          isatm = (lstr(1:4).eq.'ATOM'.or.lstr(1:6).eq.'HETATM')
          if (lstr(1:6).eq.'ENDMDL') goto 20
          if (.not.isatm) goto 15
c
c found atom
c
          read(lstr,'(12x,a4,a1,a3,1x,a1,i4,a1,3x,3f8.3)') tstr,altloc,
     &       resi,ach,iresnr,resa,(tmp(l),l=1,3)
           
          call tocap(tstr,4)
          call tocap(resi,3)

          jrest = 0
          if (resi(2:3).eq.'  ') resi = '  '//resi(1:1)

          if (resi(2:2).eq.'D'.and.resi(1:1).eq.' ') then
             if (resi(3:3).eq.'A'.or.resi(3:3).eq.'C'.or.
     &           resi(3:3).eq.'G'.or.resi(3:3).eq.'T') then
                 resi(2:2) = ' '
             endif
          endif

          do j=1,mxres
             if (resi.eq.aminos(j)) jrest = j
          end do

          if (resi.eq.'HIP'.or.resi.eq.'HID'.or.
     &            resi.eq.'HIE') then
             jrest = 17
             resi = 'HIS'
          endif

          if (jrest.eq.0) goto 15

          do i=1,4
             if (ichar(tstr(i:i)).eq.39) tstr(i:i) = '*'
          end do

          if (tstr(3:4).eq.'**'.and.tstr(2:2).ne.'O') then
             tstr(2:4) = tstr(1:3)
             tstr(1:1) = ' '
          endif

          if (tstr(2:4).eq.'OT ') tstr(2:4) = 'OXT'
          if (tstr(2:4).eq.'OCT') tstr(2:4) = 'OXT'
          if (tstr(2:4).eq.'OP2') tstr(2:4) = 'O2P'
          if (tstr(2:4).eq.'OP1') tstr(2:4) = 'O1P'

          if (iresnr.ne.irtmp.or.restmp.ne.resa) then
c
c next amino acid
c
             if (iatoms.gt.mxnat-30) goto 20

             if (skip) then
                skip = .false.
                if (iresnr.eq.irtmp.and.restmp.ne.resa) skip = .true.
             else
                if (icres.gt.0.and.jres.gt.0) then
                   call mkcon(ipdb,jres,icres,ihpdb,ihashy,0)
                   call pdbtyp(ipdb,ihpdb,jres,1)
                endif

                if (jres.ne.0) icres  = icres + 1
                if (restmp.ne.resa) skip = .true. 
             endif

             if (icres.gt.0.and.icres.le.numcal) then
                iamino(icres) = jrest
                irsnr(icres) = iresnr
                achain(icres) = ach

                if (ihashb.eq.1.and.iresnr.gt.0.and.iresnr.le.numcal) 
     &          then

                  isal(icres) = 3
                  do ii=1,icnt
                    iiscm = isc(ii) / 128
                    iscd  = (isc(ii) - iiscm*128) / 32
                    it = isc(ii) - 128*iiscm - 32*iscd

                    if (it.eq.30) then
                        it = 32
                    else
                        it = it + 65
                    endif

                    if (it.eq.ichar(ach).and.iiscm.eq.iresnr) then
                       isal(icres) = iscd
                    endif

                  end do
                endif
             endif

             irtmp = iresnr
             restmp = resa
             jres = jrest

             do j=1,mxsym
                ipdb(j) = 0
             end do

             do j=1,mxhsym*3
                ihpdb(j) = 0
             end do

             ihashy = 0
             if (skip) goto 15
          else
             if (skip) goto 15
          endif

          if (iatoms.ge.mxnat-1000) then
             dall = .true.
             goto 100
          endif

          iatoms = iatoms + 1
          ianz(iatoms) = 0
          iconn(1,iatoms) = 0
          iresid(iatoms) = icres

          do l=1,3
             coo(l,iatoms) = tmp(l)
          end do

c determine ianz, see if hydrogen atom

          call detanz(resi,tstr,lstr,ifnd,ish,ianz(iatoms),ihashy)

          ihstyp = 0

          if (ish.eq.1) then

            do j=1,mxhsym
               if (tstr(2:4).eq.hsym(j)) then
                  ihstyp = 1
                  if (ihpdb((j-1)*3+1).eq.0) then
                     aloc = altloc
                  elseif (altloc.ne.aloc) then
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                  endif

                  do l=1,3
                     if (ihpdb((j-1)*3+l).eq.0) then
                        ihpdb((j-1)*3+l) = iatoms
                        goto 1000
                     endif
                  end do

1000              continue
               endif
            end do

            if (tstr(2:4).eq.'HG3') then
                ihstyp = 1

                if (ihpdb(16).ne.0.and.ihpdb(13).eq.0) then
                     ihpdb(10) = ihpdb(16)
                     ihpdb(11) = iatoms
                     ihpdb(16) = 0
                elseif (altloc.ne.aloc) then
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                endif
            endif

            if (tstr(2:4).eq.'HD3') then
                ihstyp = 1
                if (ihpdb(25).ne.0.and.ihpdb(22).eq.0) then
                     ihpdb(19) = ihpdb(25)
                     ihpdb(20) = iatoms
                     ihpdb(25) = 0
                elseif (altloc.ne.aloc) then
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                endif
            endif

            if (tstr(2:4).eq.'HE3') then
                ihstyp = 1
                if (ihpdb(34).ne.0.and.ihpdb(31).eq.0) then
                     ihpdb(28) = ihpdb(34)
                     ihpdb(29) = iatoms
                     ihpdb(34) = 0
                     ihpdb(37) = 0
                elseif (ihpdb(34).ne.0.and.ihpdb(31).ne.0) then
                     ihpdb(28) = ihpdb(31)
                     ihpdb(29) = ihpdb(34)
                     ihpdb(30) = iatoms
                     ihpdb(31) = 0
                     ihpdb(34) = 0
                     ihpdb(37) = 0
                elseif (ihpdb(37).ne.0.and.ihpdb(31).eq.0) then
                     ihpdb(31) = ihpdb(37)
                     ihpdb(37) = iatoms
                elseif (altloc.ne.aloc) then
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                endif
            endif

            if (tstr(2:4).eq.'HZ3') then
                if (ihpdb(43).ne.0.and.ihpdb(46).ne.0.and.
     &              ihpdb(49).ne.0) then
                     ihpdb(40) = ihpdb(43)
                     ihpdb(41) = ihpdb(46)
                     ihpdb(42) = ihpdb(49)
                     ihpdb(43) = 0
                     ihpdb(46) = 0
                     ihpdb(49) = 0
                elseif (altloc.ne.aloc) then
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                endif
            endif

            if (tstr(2:3).eq.'HC') then
                ihstyp = 1
                if (altloc.ne.aloc) then
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                endif
            endif

          else

            do j=1,mxsym
               if (tstr(2:4).eq.pdbsym(j)) then
                  ihstyp = 1
c
c Allow only the first of alternate locations
c
                  if (ipdb(j).eq.0) then
                     ipdb(j) = iatoms
                  else
                     hasalt = .true.
                     iatoms = iatoms - 1
                     goto 15
                  endif
               endif
            end do

          endif

          if (ihstyp.eq.0) then
              nhmol = nhmol + 1
              iresid(iatoms) = -nhmol
              irtmp = -10000
              resi = 'UNK'
              call parsfn(resi,3,1)
              hetz(nhmol+1) = 'UNK'
          endif
          iaton(iatoms)  = 1
      end do


20    continue

c round up last amino acid

      
      if (jres.gt.0) then
         call mkcon(ipdb,jres,icres,ihpdb,ihashy,0)
         call pdbtyp(ipdb,ihpdb,jres,1)
      endif

      islu(nchain) = icres
      ncalf = icres
      namatm = iatoms
c
c do hetatm
c
      ishoh = 0
      irtmp = -10000
      resit = '   '
      tach = ' '

      call rewfil

210   call searchd(lstr,'HETATM','ATOM',istat)

      if (istat.eq.0) goto 220
      if (lstr(1:6).ne.'HETATM'.and.lstr(1:4).ne.'ATOM') goto 210
      call bckfil

      do while (.true.)
215        call nxtlin(lstr,jstat)
           if (jstat.eq.1) goto 220

           ishet = (lstr(1:6).eq.'HETATM')
           isatm = (lstr(1:4).eq.'ATOM')
           if (lstr(1:3).eq.'TER') irtmp = -10000
           if (lstr(1:6).eq.'ENDMDL') goto 220
           resi = lstr(18:20)
           if (ishet.or.isatm) then
              jrest = 0
              ishet = .false.
              if (resi(2:3).eq.'  ') resi = '  '//resi(1:1)
              if (resi(2:2).eq.'D'.and.resi(1:1).eq.' ') then
                 if (resi(3:3).eq.'A'.or.resi(3:3).eq.'C'.or.
     &               resi(3:3).eq.'G'.or.resi(3:3).eq.'T') then
                     resi(2:2) = ' '
                 endif
              endif
              do j=1,mxres
                 if (resi.eq.aminos(j)) jrest = j
              end do
              if (resi.eq.'HIP'.or.resi.eq.'HID'.or.
     &            resi.eq.'HIE') then
                 jrest = 17
                 resi = 'HIS'
              endif
              if (jrest.eq.0) ishet = .true.
           endif
           if (.not.ishet) goto 215

           if (iatoms.ge.mxnat-1000) then
               dall = .true.
               goto 100
           endif

           iatoms = iatoms + 1
           ianz(iatoms) = 0
           read(lstr,'(12x,a4,a1,a3,1x,a1,i4,4x,3f8.3)') tstr,altloc,
     &        resi,ach,iresnr, coo(1,iatoms),coo(2,iatoms),coo(3,iatoms)
           
           call tocap(tstr,4)

           if (altloc.ne.' '.and.altloc.ne.'A'.and.altloc.ne.'a'.and.
     &         altloc.ne.'1') then
              iatoms = iatoms - 1
              hasalt = .true.
              goto 215
           endif

           if (resi.ne.'HOH') then
              tmpstr = tstr(1:4)
              isl = len(tmpstr)
              call prslab(tmpstr,isl,iatoms)
           endif

           ic1 = 0
           ic2 = 0
           ls = len(lstr)
           goods = .false.
           if (ls.ge.78) then
              ic0 = ichar(lstr(76:76))
              ic1 = ichar(lstr(77:77))
              ic2 = ichar(lstr(78:78))
              goods = ( ((ic1.ge.65.and.ic1.le.90).or.ic1.eq.32) .and.
     &                  ((ic2.ge.65.and.ic2.le.90).or.ic2.eq.32) .and.
     &                  ic0.eq.32)
              if (goods) then
                  goods = (.not.(ic1.eq.32.and.ic2.eq.32))
              endif
           endif

           if (goods) then

              read(lstr,'(76x,a2)') tstr(1:2)

              do j=1,99
                if (tstr(1:2).eq.tocapf(elemnt(j))) ianz(iatoms) = j
              end do
            
           else

              if (resi.eq.'HEM') then
                 if (tstr(1:2).eq.'HA'.or.tstr(1:2).eq.'HB'.or.
     &               tstr(1:2).eq.'HM') tstr(1:4) = ' H  '
                 if (tstr(2:3).eq.'FE') tstr(1:3) = 'FE '
              endif

              if (resi.eq.'NDP') then
                 if (tstr(1:2).eq.'NP') tstr(1:4) = ' P  '
              endif

              do j=1,4
                 if (tocapf(tstr(1:2)).eq.hetred(j)) then
                     tstr(1:1) = ' '
                 endif
              end do

              it = ichar(tstr(1:1))
              if (.not.(it.ge.65.and.it.le.90).and..not.
     &           (it.ge.97.and.it.le.122)) tstr(1:1) = ' '
              it2 = ichar(tstr(2:2))
              if (.not.(it2.ge.65.and.it2.le.90).and..not.
     &           (it2.ge.97.and.it2.le.122)) tstr(2:2) = ' '
              if (tstr(2:2).eq.' '.and.tstr(1:1).ne.' ') then
                 tstr(2:2) = tstr(1:1)
                 tstr(1:1) = ' '
              endif 

              do j=1,99
                if (tstr(1:2).eq.tocapf(elemnt(j))) ianz(iatoms) = j
              end do

              if (ianz(iatoms).eq.0.and.tstr(1:1).ne.' ') then
                 tstr(1:1) = ' '
                 do j=1,99
                     if (tstr(1:2).eq.tocapf(elemnt(j))) 
     &                  ianz(iatoms) = j
                 end do
              endif

           endif

           if (ianz(iatoms).le.0) then
              write(iun3,*) 'Unclassified atom =',tstr
              write(iun3,*) lstr
              ianz(iatoms) = 99
           endif

           iconn(1,iatoms) = 0
           iaton(iatoms)  = 0

           if (iresnr.ne.irtmp.or.resi(1:3).ne.resit(1:3).or.
     &         ach.ne.tach) then
              irtmp = iresnr
              resit = resi
              tach = ach

              if (resi(1:3).eq.'HOH'.or.resi(1:3).eq.'hoh') then
                  if (ishoh.eq.0) then
                     nhmol = nhmol + 1
                     if (nmulm.lt.mxmmul) nmulm = nmulm + 1
                     call parsfn(resi,3,1)
                     hetz(nhmol+1) = resi(1:3)
                     ishoh = nhmol
                  endif  
              else
                  nhmol = nhmol + 1
                  if (nmulm.lt.mxmmul) nmulm = nmulm + 1
                  call parsfn(resi,3,1)
                  hetz(nhmol+1) = resi(1:3)
              endif

           endif

           if (resi(1:3).eq.'HOH'.or.resi(1:3).eq.'hoh') then
              iresid(iatoms) = -ishoh
           else
              iresid(iatoms) = -nhmol
           endif
      end do

220   continue

c
c do connectivity between all except amino-amino
c
      nhet = iatoms - namatm
      do ii=1,nhet
         i = namatm + ii
         do j=1,namatm + ii - 1
            call connij(idum,i,j,0)
         end do
      end do

c
c make s-s connections
c
      do i=1,ncalf
         if (iamino(i).eq.4) then
            do j=1,i-1
               if (iamino(j).eq.4) then
                  ii = 0
                  jj = 0
                  do k=1,iatoms
                     if (ianz(k).eq.16) then
                        if (iresid(k).eq.i) ii = k
                        if (iresid(k).eq.j) jj = k
                     endif
                  end do
                  if (ii.ne.0.and.jj.ne.0) then
                     call connij(idum,ii,jj,0)
                     if (idum.eq.1) then
                        ityp(ii) = 82
                        ityp(jj) = 82
                        do l=1,iconn(1,ii)
                           ll = iabs(iconn(l+1,ii))
                           if (ianz(ll).eq.6) ityp(ll) = 38
                        end do
                        do l=1,iconn(1,jj)
                           ll = iabs(iconn(l+1,jj))
                           if (ianz(ll).eq.6) ityp(ll) = 38
                        end do
                     endif
                  endif
               endif
            end do
         endif
      end do

      do i=1,ncalf
         if (iamino(i).eq.21) iamino(i) = 10
         if (iamino(i).eq.22) iamino(i) = 14
      end do

      if (islu(1).lt.ianf(1)) nchain = 0

      if (ioadd.eq.1) then
         if (nmulmt.eq.0) nmulmt = 1
         do i=nmulmt,nmulm
            ihasqm(i) = 0
         end do
         do i=nmulmt+4,nhmol+1
            ihet(i) = 1
         end do
      endif

      ihashz = 1

      if (hasalt) print*,'Alternate location(s) detected'
      return

100   istat = 0
      if (dall) then
         iatoms = natorg
         ncalf = noff
         istat = -1
      else
         if (islu(1).lt.ianf(1)) nchain = 0
      endif
      if (hasalt) print*,'Alternate location(s) detected'
      return
      end



      subroutine flagd(ihpdb,iat,isurf)
      implicit double precision (a-h,o-z)
      dimension ihpdb(*),isurf(*)

      if (ihpdb(iat).ne.0) isurf(ihpdb(iat)) = 1

      return
      end

      subroutine conad(ipdb,iat1,iat2,iop,iconn)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      dimension ipdb(*),iconn(mxcon+1,*)

      ia1 = ipdb(iat1)
      ia2 = ipdb(iat2)

      if (ia1.ne.0.and.ia2.ne.0) then
         if (iconn(1,ia1).lt.mxcon) then
            iconn(1,ia1) = iconn(1,ia1) + 1
            iconn(iconn(1,ia1)+1,ia1) = ia2
         endif
         if (iop.eq.0) then
            iconn(1,ia2) = 1
            iconn(2,ia2) = ia1
         else
            if (iconn(1,ia2).lt.mxcon) then
               iconn(1,ia2) = iconn(1,ia2) + 1
               iconn(iconn(1,ia2)+1,ia2) = ia1
            endif
         endif
      endif

      return
      end

      subroutine conatd(ipdb,ihpdb,iat1,iat2,iconn)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      dimension ipdb(*), ihpdb(*), iconn(mxcon+1,*)

      ia1 = ipdb(iat1)
      ia2 = ihpdb(iat2)

      if (ia1.ne.0.and.ia2.ne.0) then
         if (iconn(1,ia1).lt.mxcon) then
            iconn(1,ia1) = iconn(1,ia1) + 1
            iconn(iconn(1,ia1)+1,ia1) = ia2
         endif
         iconn(1,ia2) = 1
         iconn(2,ia2) = ia1
      endif

      return
      end

      subroutine mkcon(ipdb,jres,icres,ihpdb,ihashy,idoconv)
      implicit double precision (a-h,o-z)
      dimension ipdb(*), ihpdb(*)

      if (jres.gt.23) then
         call mknbck(ipdb,ihpdb,jres,icres,ihashy,idoconv)
      else
         call mkback(ipdb,ihpdb,jres,icres,ihashy,idoconv)
      endif
          

      goto (10,10,30,40,50,60,70,80,90,100,110,120,130,140,150,
     &      160,170,180,190,200,100,140,150,210,220,230,240,250,
     &      210,220,220,230,230,230,230,230,230,230,250,250,250,
     &      250) jres
      return
c
c glycine, alanine
c
10    goto 1000
c
c serine
c
30    call conat(ipdb,5,31,0)
      if (ihashy.eq.1) call conath(ipdb,ihpdb,31,10)
      goto 1000
c
c cysteine
c
40    call conat(ipdb,5,37,0)
c this H is dubious
      if (ihashy.eq.1) call conath(ipdb,ihpdb,37,10)
      goto 1000
c
c threonine
c
50    call conat(ipdb,5,32,0)
      call conat(ipdb,5,8,0)
      if (ihashy.eq.1) then
          call conath(ipdb,ihpdb,32,10)
          call conath(ipdb,ihpdb,32,13)
          call conath(ipdb,ihpdb,8,16)
          call conath(ipdb,ihpdb,8,17)
          call conath(ipdb,ihpdb,8,18)
      endif
      goto 1000
c
c isoleucine
c
60    call conat(ipdb,5,7,0)
      call conat(ipdb,5,8,0)
      call conat(ipdb,7,10,0)
      if (ihashy.eq.1) then
          call conath(ipdb,ihpdb,7,13)
          call conath(ipdb,ihpdb,7,14)
          call conath(ipdb,ihpdb,8,16)
          call conath(ipdb,ihpdb,8,17)
          call conath(ipdb,ihpdb,8,18)
          call conath(ipdb,ihpdb,10,22)
          call conath(ipdb,ihpdb,10,23)
          call conath(ipdb,ihpdb,10,24)
      endif
      goto 1000
c
c valine
c
70    call conat(ipdb,5,7,0)
      call conat(ipdb,5,8,0)
      if (ihashy.eq.1) then
          call conath(ipdb,ihpdb,7,13)
          call conath(ipdb,ihpdb,7,14)
          call conath(ipdb,ihpdb,7,15)
          call conath(ipdb,ihpdb,8,16)
          call conath(ipdb,ihpdb,8,17)
          call conath(ipdb,ihpdb,8,18)
      endif
      goto 1000
c
c methionine
c
80    call conat(ipdb,5,6,0)
      call conat(ipdb,6,36,0)
      call conat(ipdb,36,12,0)
      if (ihashy.eq.1) then
          call conath(ipdb,ihpdb,6,10)
          call conath(ipdb,ihpdb,6,11)
c        try HG1 and HG2 too
          call conath(ipdb,ihpdb,6,13)
          call conath(ipdb,ihpdb,6,16)
          call conath(ipdb,ihpdb,12,28)
          call conath(ipdb,ihpdb,12,29)
          call conath(ipdb,ihpdb,12,30)
          call conath(ipdb,ihpdb,12,31)
          call conath(ipdb,ihpdb,12,34)
          call conath(ipdb,ihpdb,12,37)
      endif
      goto 1000
c
c aspartic acid
c
90    call conat(ipdb,5,6,0)
      call conat(ipdb,6,29,0)
      call conat(ipdb,6,30,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,29,22)
         call conath(ipdb,ihpdb,30,25)
      endif
      goto 1000
c
c asparagine
c
100   call conat(ipdb,5,6,0)
      call conat(ipdb,6,29,0)
      call conat(ipdb,6,21,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,21,25)
         call conath(ipdb,ihpdb,21,26)
      endif
      goto 1000
c
c leucine
c
110   call conat(ipdb,5,6,0)
      call conat(ipdb,6,10,0)
      call conat(ipdb,6,11,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,6,10)
         call conath(ipdb,ihpdb,10,22)
         call conath(ipdb,ihpdb,10,23)
         call conath(ipdb,ihpdb,10,24)
         call conath(ipdb,ihpdb,11,25)
         call conath(ipdb,ihpdb,11,26)
         call conath(ipdb,ihpdb,11,27)
      endif
      goto 1000
c
c lysine
c
120   call conat(ipdb,5,6,0)
      call conat(ipdb,6,9,0)
      call conat(ipdb,9,12,0)
      call conat(ipdb,12,27,0)
      if (ihashy.eq.1) then

         call conath(ipdb,ihpdb,6,10)
         call conath(ipdb,ihpdb,6,11)
c        try HG1 and HG2 too
         call conath(ipdb,ihpdb,6,13)
         call conath(ipdb,ihpdb,6,16)

         call conath(ipdb,ihpdb,9,19)
         call conath(ipdb,ihpdb,9,20)
c        try HD1 and HD2 too
         call conath(ipdb,ihpdb,9,22)
         call conath(ipdb,ihpdb,9,25)

         call conath(ipdb,ihpdb,12,28)
         call conath(ipdb,ihpdb,12,29)
c        try HE1 and HE2 , HE3 too
         call conath(ipdb,ihpdb,12,31)
         call conath(ipdb,ihpdb,12,34)
         call conath(ipdb,ihpdb,12,37)

         call conath(ipdb,ihpdb,27,40)
         call conath(ipdb,ihpdb,27,41)
         call conath(ipdb,ihpdb,27,42)
         call conath(ipdb,ihpdb,27,43)
         call conath(ipdb,ihpdb,27,46)
         call conath(ipdb,ihpdb,27,49)
      endif
      goto 1000
c
c glutamic acid
c
130   call conat(ipdb,5,6,0)
      call conat(ipdb,6,9,0)
      call conat(ipdb,9,34,0)
      call conat(ipdb,9,35,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,6,10)
         call conath(ipdb,ihpdb,6,11)
c        try HG1 and HG2 too
         call conath(ipdb,ihpdb,6,13)
         call conath(ipdb,ihpdb,6,16)
         call conath(ipdb,ihpdb,34,31)
         call conath(ipdb,ihpdb,35,34)
      endif
      goto 1000
c
c glutamine
c
140   call conat(ipdb,5,6,0)
      call conat(ipdb,6,9,0)
      call conat(ipdb,9,34,0)
      call conat(ipdb,9,24,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,6,10)
         call conath(ipdb,ihpdb,6,11)
c        try HG1 and HG2 too
         call conath(ipdb,ihpdb,6,13)
         call conath(ipdb,ihpdb,6,16)
         call conath(ipdb,ihpdb,24,34)
         call conath(ipdb,ihpdb,24,35)
      endif
      goto 1000
c
c proline
c 
150   call conat(ipdb,5,6,0)
      call conat(ipdb,6,9,0)
c     bit tricky here
      call conat(ipdb,9,1,1)
      if (ipdb(28).ne.0) call conat(ipdb,6,28,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,6,10)
         call conath(ipdb,ihpdb,6,11)
c        try HG1 and HG2 too
         call conath(ipdb,ihpdb,6,13)
         call conath(ipdb,ihpdb,6,16)
         call conath(ipdb,ihpdb,9,19)
         call conath(ipdb,ihpdb,9,20)
c        try HD1 and HD2 too
         call conath(ipdb,ihpdb,9,22)
         call conath(ipdb,ihpdb,9,25)
      endif
      goto 1000
c
c arginine
c
160   call conat(ipdb,5,6,0)
      call conat(ipdb,6,9,0)
      call conat(ipdb,9,22,0)
      call conat(ipdb,22,17,0)
      call conat(ipdb,17,25,0)
      call conat(ipdb,17,26,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,6,10)
         call conath(ipdb,ihpdb,6,11)
         call conath(ipdb,ihpdb,6,13)
         call conath(ipdb,ihpdb,6,16)
         call conath(ipdb,ihpdb,9,19)
         call conath(ipdb,ihpdb,9,20)
         call conath(ipdb,ihpdb,9,22)
         call conath(ipdb,ihpdb,9,25)
         call conath(ipdb,ihpdb,22,28)
         call conath(ipdb,ihpdb,25,55)
         call conath(ipdb,ihpdb,25,56)
         call conath(ipdb,ihpdb,26,58)
         call conath(ipdb,ihpdb,26,59)
      endif
      goto 1000
c
c histidine
c
170   call conat(ipdb,5,6,0)
      call conat(ipdb,6,11,0)
      call conat(ipdb,6,20,0)
      call conat(ipdb,11,24,0)
      call conat(ipdb,20,13,0)
c tricky
      call conat(ipdb,13,24,1)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,20,22)
         call conath(ipdb,ihpdb,11,25)
         call conath(ipdb,ihpdb,13,31)
         call conath(ipdb,ihpdb,24,34)
      endif
      goto 1000
c
c phenylalanine
c
180   call conat(ipdb,5,6,0)
      call conat(ipdb,6,10,0)
      call conat(ipdb,6,11,0)
      call conat(ipdb,10,13,0)
      call conat(ipdb,11,14,0)
      call conat(ipdb,13,17,0)
      call conat(ipdb,14,17,1)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,10,22)
         call conath(ipdb,ihpdb,11,25)
         call conath(ipdb,ihpdb,13,31)
         call conath(ipdb,ihpdb,14,34)
         call conath(ipdb,ihpdb,17,40)
      endif
      goto 1000
c
c tyrosine
c
190   call conat(ipdb,5,6,0)
      call conat(ipdb,6,10,0)
      call conat(ipdb,6,11,0)
      call conat(ipdb,10,13,0)
      call conat(ipdb,11,14,0)
      call conat(ipdb,13,17,0)
      call conat(ipdb,14,17,1)
      call conat(ipdb,17,33,0)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,10,22)
         call conath(ipdb,ihpdb,11,25)
         call conath(ipdb,ihpdb,13,31)
         call conath(ipdb,ihpdb,14,34)
         call conath(ipdb,ihpdb,33,52)
      endif
      goto 1000
c
c tryptophan
c
200   call conat(ipdb,5,6,0)
      call conat(ipdb,6,10,0)
      call conat(ipdb,6,11,0)
      call conat(ipdb,10,23,0)
      call conat(ipdb,23,14,0)
      call conat(ipdb,14,11,1)
      call conat(ipdb,11,15,0)
      call conat(ipdb,14,18,0)
      call conat(ipdb,15,19,0)
      call conat(ipdb,18,16,0)
      call conat(ipdb,16,19,1)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,10,22)
         call conath(ipdb,ihpdb,23,31)
         call conath(ipdb,ihpdb,15,37)
         call conath(ipdb,ihpdb,18,46)
         call conath(ipdb,ihpdb,19,49)
         call conath(ipdb,ihpdb,16,58)
      endif
      goto 1000
c
c adenosine
c
210   call conat(ipdb,54,66,0)
      call conat(ipdb,66,59,0)
      call conat(ipdb,66,56,0)
      call conat(ipdb,59,65,0)
      call conat(ipdb,65,57,0)
      call conat(ipdb,57,58,0)
      call conat(ipdb,57,56,0)
      call conat(ipdb,58,64,0)
      call conat(ipdb,58,60,0)
      call conat(ipdb,60,55,0)
      call conat(ipdb,55,62,0)
      call conat(ipdb,56,62,1)
      call conat(ipdb,56,66,1)
      if (jres.eq.29) then
          call conat(ipdb,60,71,0)
          call conat(ipdb,60,79,0)
      endif
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,55,82)
         call conath(ipdb,ihpdb,59,112)
         call conath(ipdb,ihpdb,64,106)
         call flagh(ihpdb,106)
         call conath(ipdb,ihpdb,64,109)
         call flagh(ihpdb,109)
         call conath(ipdb,ihpdb,64,136)
         call flagh(ihpdb,136)
         call conath(ipdb,ihpdb,64,137)
         call flagh(ihpdb,137)
         call conath(ipdb,ihpdb,64,103)
         call flagh(ihpdb,103)
         call conath(ipdb,ihpdb,64,104)
         call flagh(ihpdb,104)
         if (jres.eq.29) then
             call conath(ipdb,ihpdb,79,148)
             call conath(ipdb,ihpdb,79,149)
             call conath(ipdb,ihpdb,79,150)
             call conath(ipdb,ihpdb,58,103)
         endif
      endif
      goto 1000
c
c cytidine
c
220   call conat(ipdb,54,60,0)
      call conat(ipdb,60,55,0)
      call conat(ipdb,55,67,0)
      call conat(ipdb,55,62,0)
      call conat(ipdb,62,56,0)
      call conat(ipdb,56,63,0)
      call conat(ipdb,56,57,0)
      call conat(ipdb,57,58,0)
      call conat(ipdb,60,58,1)
      if (jres.eq.30) then
         call conat(ipdb,57,72,0)
         call conat(ipdb,57,83,0)
      endif
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,63,94)
         call flagh(ihpdb,94)
         call conath(ipdb,ihpdb,63,97)
         call flagh(ihpdb,97)
         call conath(ipdb,ihpdb,63,130)
         call flagh(ihpdb,130)
         call conath(ipdb,ihpdb,63,131)
         call flagh(ihpdb,131)
         call conath(ipdb,ihpdb,58,103)
         if (jres.eq.30) then
             call conath(ipdb,ihpdb,83,160)
             call conath(ipdb,ihpdb,83,161)
             call conath(ipdb,ihpdb,83,162)
         else
             call conath(ipdb,ihpdb,57,100)
         endif
      endif
      goto 1000
c
c guanosine
c
230   call conat(ipdb,54,66,0)
      call conat(ipdb,66,59,0)
      call conat(ipdb,66,56,0)
      call conat(ipdb,59,65,0)
      call conat(ipdb,65,57,0)
      call conat(ipdb,57,58,0)
      call conat(ipdb,57,56,0)
      call conat(ipdb,58,69,0)
      call conat(ipdb,58,60,0)
      call conat(ipdb,60,55,0)
      call conat(ipdb,55,62,0)
      if (jres.ne.38) call conat(ipdb,55,61,0)
      call conat(ipdb,56,62,1)
      call conat(ipdb,56,66,1)
      if (jres.eq.32) then
          call conat(ipdb,60,71,0)
          call conat(ipdb,60,79,0)
      endif
      if (jres.eq.33.or.jres.eq.34) then
          call conat(ipdb,61,73,0)
          call conat(ipdb,61,80,0)
      endif
      if (jres.eq.34) then
          call conat(ipdb,61,74,0)
          call conat(ipdb,61,79,0)
      endif
      if (jres.eq.35) then
          call conat(ipdb,65,75,0)
          call conat(ipdb,65,85,0)
      endif
      if (jres.eq.37) then
          call conat(ipdb,61,90,0)
          call conat(ipdb,62,88,0)
          call conat(ipdb,90,89,0)
          call conat(ipdb,90,91,0)
          call conat(ipdb,91,60,1)
          call conat(ipdb,91,92,0)
          call conat(ipdb,92,93,0)
          call conat(ipdb,93,94,0)
          call conat(ipdb,94,95,0)
          call conat(ipdb,95,96,0)
          call conat(ipdb,95,97,0)
          call conat(ipdb,97,98,0)
          call conat(ipdb,94,99,0)
          call conat(ipdb,99,100,0)
          call conat(ipdb,100,101,0)
          call conat(ipdb,100,102,0)
          call conat(ipdb,102,103,0)
      endif

      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,59,112)
         if (jres.ne.32.and.jres.ne.37) then
            call conath(ipdb,ihpdb,60,79)
            call flagh(ihpdb,79)
            call conath(ipdb,ihpdb,60,121)
            call flagh(ihpdb,121)
         endif
         if (jres.ne.33.and.jres.ne.34.and.jres.ne.37
     &       .and.jres.ne.38) then
            call conath(ipdb,ihpdb,61,85)
            call flagh(ihpdb,85)
            call conath(ipdb,ihpdb,61,125)
            call flagh(ihpdb,125)
            call conath(ipdb,ihpdb,61,82)
            call flagh(ihpdb,82)
            call conath(ipdb,ihpdb,61,83)
            call flagh(ihpdb,83)
         endif
         if (jres.ne.34.and.jres.ne.37.and.jres.ne.38) then
            call conath(ipdb,ihpdb,61,88)
            call flagh(ihpdb,88)
            call conath(ipdb,ihpdb,61,124)
            call flagh(ihpdb,124)
         endif
         if (jres.eq.33.or.jres.eq.34) then
            call conath(ipdb,ihpdb,80,151)
            call conath(ipdb,ihpdb,80,152)
            call conath(ipdb,ihpdb,80,153)
         endif
         if (jres.eq.31.or.jres.eq.34) then
            call conath(ipdb,ihpdb,79,148)
            call conath(ipdb,ihpdb,79,149)
            call conath(ipdb,ihpdb,79,150)
         endif
         if (jres.eq.35) then
            call conath(ipdb,ihpdb,85,166)
            call conath(ipdb,ihpdb,85,167)
            call conath(ipdb,ihpdb,85,168)
            call conath(ipdb,ihpdb,59,113)
         endif
         if (jres.eq.37) then
            call conath(ipdb,ihpdb,88,91)
            call conath(ipdb,ihpdb,88,92)
            call conath(ipdb,ihpdb,88,93)
            call conath(ipdb,ihpdb,89,175)
            call conath(ipdb,ihpdb,89,176)
            call conath(ipdb,ihpdb,89,177)
            call conath(ipdb,ihpdb,92,178)
            call conath(ipdb,ihpdb,92,179)
            call conath(ipdb,ihpdb,93,181)
            call conath(ipdb,ihpdb,93,182)
            call conath(ipdb,ihpdb,94,184)
            call conath(ipdb,ihpdb,98,187)
            call conath(ipdb,ihpdb,98,188)
            call conath(ipdb,ihpdb,98,189)
            call conath(ipdb,ihpdb,99,124)
            call conath(ipdb,ihpdb,103,190)
            call conath(ipdb,ihpdb,103,191)
            call conath(ipdb,ihpdb,103,192)
         endif
      endif
      goto 1000
c
c thymidine
c
240   call conat(ipdb,54,60,0)
      call conat(ipdb,60,55,0)
      call conat(ipdb,55,67,0)
      call conat(ipdb,55,62,0)
      call conat(ipdb,62,56,0)
      call conat(ipdb,56,68,0)
      call conat(ipdb,56,57,0)
      call conat(ipdb,57,58,0)
      call conat(ipdb,60,58,1)
      call conat(ipdb,57,70,1)
      call conat(ipdb,57,83,1)
      call conat(ipdb,57,75,1)
      call conat(ipdb,57,85,1)
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,58,103)
         call conath(ipdb,ihpdb,62,91)
         call flagh(ihpdb,91)
         call conath(ipdb,ihpdb,62,127)
         call flagh(ihpdb,127)
         call conath(ipdb,ihpdb,83,160)
         call conath(ipdb,ihpdb,83,161)
         call conath(ipdb,ihpdb,83,162)
         call conath(ipdb,ihpdb,70,160)
         call conath(ipdb,ihpdb,70,161)
         call conath(ipdb,ihpdb,70,162)
         call conath(ipdb,ihpdb,75,166)
         call conath(ipdb,ihpdb,75,167)
         call conath(ipdb,ihpdb,75,168)
         call conath(ipdb,ihpdb,85,166)
         call conath(ipdb,ihpdb,85,167)
         call conath(ipdb,ihpdb,85,168)
      endif
      goto 1000
c
c uridine
c
250   if (jres.eq.42) then
         call conat(ipdb,54,57,0)
      else
         call conat(ipdb,54,60,0)
      endif
      call conat(ipdb,60,55,0)
      call conat(ipdb,55,67,0)
      call conat(ipdb,55,62,0)
      call conat(ipdb,62,56,0)
      call conat(ipdb,56,68,0)
      call conat(ipdb,56,57,1)
      call conat(ipdb,57,58,0)
      call conat(ipdb,60,58,1)
      if (jres.eq.41) then
         call conat(ipdb,57,72,0)
         call conat(ipdb,57,83,0)
      endif
      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,58,103)
         if (jres.ne.41.and.jres.ne.42) call conath(ipdb,ihpdb,57,100)
         if (jres.eq.40) then
            call conath(ipdb,ihpdb,58,104)
            call conath(ipdb,ihpdb,57,101)
         endif
         call conath(ipdb,ihpdb,62,91)
         call flagh(ihpdb,91)
         call conath(ipdb,ihpdb,62,127)
         call flagh(ihpdb,127)
         if (jres.eq.41) then
            call conath(ipdb,ihpdb,83,160)
            call conath(ipdb,ihpdb,83,161)
            call conath(ipdb,ihpdb,83,162)
         endif
         if (jres.eq.42) call conath(ipdb,ihpdb,60,121)
      endif

1000  continue

      return
      end

      subroutine mknbcd(ipdb,ihpdb,jres,icres,ihashy,idoconv,
     &                  iconn,coo,
     &                  icalf,ianf,islu,nchain,iamino)
      implicit double precision (a-h,o-z)
      parameter (numcal=50000)
      parameter (mxchai=50)
      parameter (mxcon=10)
      logical newch
      dimension ipdb(*),ihpdb(*),tmp(3),coo(3,*),iconn(mxcon+1,*)
      dimension icalf(6,*),ianf(*),islu(*),iamino(*)

      fct = 1.0d0
      if (idoconv.eq.1) fct = 1.0d0 / (0.52917706d0*0.52917706d0)

      if (ipdb(43).gt.0) then
         nc = 0
         if (ipdb(44).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(43)) = ipdb(44)
         endif
         if (ipdb(45).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(43)) = ipdb(45)
         endif
         if (ipdb(46).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(43)) = ipdb(46)
         endif
         iconn(1,ipdb(43)) = nc
      endif

      if (ipdb(44).gt.0) iconn(1,ipdb(44)) = 0
      if (ipdb(45).gt.0) iconn(1,ipdb(45)) = 0
      if (ipdb(46).gt.0) iconn(1,ipdb(46)) = 0

      if (ipdb(43).gt.0) then

         if (ipdb(44).gt.0) then
            iconn(2,ipdb(44)) = ipdb(43)
            iconn(1,ipdb(44)) = 1
         endif

         if (ipdb(45).gt.0) then
            iconn(2,ipdb(45)) = ipdb(43)
            iconn(1,ipdb(45)) = 1
         endif

         if (ipdb(46).gt.0) then
            iconn(2,ipdb(46)) = ipdb(43)
            iconn(1,ipdb(46)) = 1
         endif
      endif


      if (ipdb(47).gt.0) then
         if (ipdb(46).gt.0) then
            iconn(1,ipdb(46)) = iconn(1,ipdb(46)) + 1
            iconn(1+iconn(1,ipdb(46)),ipdb(46)) = ipdb(47)
            iconn(2,ipdb(47)) = ipdb(46)
            iconn(1,ipdb(47)) = 1
         endif
         if (ipdb(48).gt.0) then
            if (ipdb(46).gt.0) then
               iconn(1,ipdb(47)) = 2
               iconn(3,ipdb(47)) = ipdb(48)
            else
               iconn(1,ipdb(47)) = 1
               iconn(2,ipdb(47)) = ipdb(48)
            endif
         endif
      endif

      if (ipdb(48).gt.0) then
         nc = 0
         if (ipdb(47).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(48)) = ipdb(47)
         endif
         if (ipdb(49).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(48)) = ipdb(49)
         endif
         if (ipdb(50).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(48)) = ipdb(50)
         endif
         iconn(1,ipdb(48)) = nc
      endif

      if (ipdb(49).gt.0) then
         nc = 0
         if (ipdb(48).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(49)) = ipdb(48)
         endif
         if (ipdb(54).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(49)) = ipdb(54)
         endif
         iconn(1,ipdb(49)) = nc
      endif

      if (ipdb(49).gt.0) then
         nc = 0
         if (ipdb(48).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(50)) = ipdb(48)
         endif
         if (ipdb(51).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(50)) = ipdb(51)
         endif
         if (ipdb(52).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(50)) = ipdb(52)
         endif
         iconn(1,ipdb(50)) = nc
      endif

      if (ipdb(50).gt.0.and.ipdb(51).gt.0) then
         iconn(1,ipdb(51)) = 1
         iconn(2,ipdb(51)) = ipdb(50)
      endif

      if (ipdb(52).gt.0) then
         nc = 0
         if (ipdb(50).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(52)) = ipdb(50)
         endif
         if (ipdb(54).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(52)) = ipdb(54)
         endif
         iconn(1,ipdb(52)) = nc
      endif

      if (ipdb(53).gt.0.and.ipdb(52).gt.0) then
         nc = iconn(1,ipdb(52))
         nc = nc + 1
         iconn(1+nc,ipdb(52)) = ipdb(53)
         iconn(1,ipdb(52)) = nc
         iconn(1,ipdb(53)) = 1
         iconn(2,ipdb(53)) = ipdb(52)
      endif

      if (ipdb(54).ne.0) then
         nc = 0
         if (ipdb(54).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(54)) = ipdb(49)
         endif
         if (ipdb(54).gt.0) then
            nc = nc + 1
            iconn(1+nc,ipdb(54)) = ipdb(52)
         endif
         iconn(1,ipdb(54)) = nc
      endif

c Possible OXT

      if (ipdb(38).ne.0.and.ipdb(43).ne.0) then
         nc = iconn(1,ipdb(43))
         nc = nc + 1
         iconn(1+nc,ipdb(43)) = ipdb(38)
         iconn(1,ipdb(43)) = nc
         iconn(1,ipdb(38)) = 1
         iconn(2,ipdb(38)) = ipdb(43)
      endif

c Possible O3P (OXT is old O3P new)

      if (ipdb(76).ne.0.and.ipdb(43).ne.0) then
         nc = iconn(1,ipdb(43))
         nc = nc + 1
         iconn(1+nc,ipdb(43)) = ipdb(76)
         iconn(1,ipdb(43)) = nc
         iconn(1,ipdb(76)) = 1
         iconn(2,ipdb(76)) = ipdb(43)
      endif

      if (jres.eq.36.or.jres.eq.31) then
          call conat(ipdb,53,73,0)
          call conat(ipdb,53,80,0)
      endif

      if (ihashy.eq.1) then
         call conath(ipdb,ihpdb,47,61)
         call conath(ipdb,ihpdb,47,62)
         call conath(ipdb,ihpdb,48,64)
         call conath(ipdb,ihpdb,50,67)
         call conath(ipdb,ihpdb,52,70)
         call conath(ipdb,ihpdb,52,71)
         call conath(ipdb,ihpdb,54,73)
         if (ipdb(53).ne.0) call conath(ipdb,ihpdb,53,76)
         if ((jres.eq.36.or.jres.eq.31).and.ipdb(80).ne.0) then
             call conath(ipdb,ihpdb,80,151)
             call conath(ipdb,ihpdb,80,152)
             call conath(ipdb,ihpdb,80,153)
         endif
         call conath(ipdb,ihpdb,51,115)
         call conath(ipdb,ihpdb,46,118)
      endif

      if (icres.le.numcal) then
         icalf(1,icres) = ipdb(43)
         icalf(2,icres) = ipdb(46)
         icalf(3,icres) = ipdb(47)
         icalf(4,icres) = ipdb(48)
         icalf(5,icres) = ipdb(50)
         icalf(6,icres) = ipdb(51)
      endif

      if (ipdb(43).eq.0.and.icres.le.numcal) then
         if (ihpdb(118).ne.0) then
             icalf(1,icres) = ihpdb(118)
         elseif (ipdb(46).ne.0) then
             icalf(1,icres) = ipdb(46)
         endif
      endif

      if (icres.gt.1.and.icres.le.numcal) then
         newch = .false.
         if (iamino(icres-1).gt.23) then
            ip = ipdb(43)
            io = icalf(6,icres-1)
            if (io.gt.0.and.ip.gt.0) then
               do i=1,3
                  tmp(i) = coo(i,ip) - coo(i,io)
               end do
               distsq = tmp(1)*tmp(1) + tmp(2)*tmp(2) +
     &                  tmp(3)*tmp(3)
            else
               distsq = 100000.0d0
            endif
            if (distsq.lt.3.1684d0*fct) then
c
c connect P current residue to O previous
c
               iconn(1,ip) = iconn(1,ip) + 1 
               iconn(iconn(1,ip)+1,ip) = io
c
c connect O previous to P current residue 
c
               iconn(1,io) = iconn(1,io) + 1 
               iconn(iconn(1,io)+1,io) = ip
            else
               newch = .true.
            endif
         else
            newch = .true.
         endif

         if (newch.and.idoconv.eq.0) then
            if (nchain.lt.mxchai) then
               islu(nchain) = icres-1
               nchain = nchain + 1
               ianf(nchain) = icres
            endif
         endif

      endif

      return
      end

      subroutine mkbacd(ipdb,ihpdb,jres,icres,ihashy,idoconv,
     &                  iconn,coo,
     &                  icalf,ianf,islu,nchain,iamino)

      implicit double precision (a-h,o-z)
      parameter (numcal=50000)
      parameter (mxchai=50)
      parameter (mxcon=10)
      logical newch
      dimension ipdb(*),ihpdb(*),tmp(3),coo(3,*),iconn(mxcon+1,*)
      dimension icalf(6,*),ianf(*),islu(*),iamino(*)


      fct = 1.0d0
      if (idoconv.eq.1) fct = 1.0d0 / (0.52917706d0*0.52917706d0)

c N-CA
      if (ipdb(1).ne.0.and.ipdb(2).ne.0) then
         iconn(1,ipdb(1)) = 1
         iconn(2,ipdb(1)) = ipdb(2)
      endif

c CA-N, CA-C
      if (ipdb(2).ne.0) then
         iconn(1,ipdb(2)) = 0
         if (ipdb(1).ne.0) then
            iconn(2,ipdb(2)) = ipdb(1)
            iconn(1,ipdb(2)) = 1
            if (ipdb(3).ne.0) then
               iconn(3,ipdb(2)) = ipdb(3)
               iconn(1,ipdb(2)) = 2
            endif
         else
            if (ipdb(3).ne.0) then
               iconn(2,ipdb(2)) = ipdb(3)
               iconn(1,ipdb(2)) = 1
            endif
         endif
      endif

c C-CA,C-O
      if (ipdb(4).ne.0.and.ipdb(3).ne.0) then
         iconn(1,ipdb(3)) = 0
         if (ipdb(2).ne.0) then
            iconn(2,ipdb(3)) = ipdb(2)
            iconn(3,ipdb(3)) = ipdb(4)
            iconn(1,ipdb(3)) = 2
         else
            iconn(2,ipdb(3)) = ipdb(4)
            iconn(1,ipdb(3)) = 1
         endif
c O-C
         iconn(1,ipdb(4)) = 1
         iconn(2,ipdb(4)) = ipdb(3)

      elseif (ipdb(3).ne.0.and.ipdb(2).ne.0) then
         iconn(1,ipdb(3)) = 1
         iconn(2,ipdb(3)) = ipdb(2)
      elseif (ipdb(3).ne.0) then
         iconn(1,ipdb(3)) = 0
      elseif (ipdb(4).ne.0) then
         iconn(1,ipdb(4)) = 0
      endif

c Possible OXT
      if (ipdb(38).ne.0.or.ipdb(76).ne.0) then
         if (ipdb(38).ne.0) then
            iox = ipdb(38)
         else
            iox = ipdb(76)
         endif
         iconn(1,ipdb(3)) = iconn(1,ipdb(3)) + 1
         iconn(iconn(1,ipdb(3))+1,ipdb(3)) = iox
         iconn(1,iox) = 1
         iconn(2,iox) = ipdb(3)
      endif

c C beta
      if (jres.gt.1.and.ipdb(5).ne.0) then
         iconn(1,ipdb(2)) = 3
         iconn(4,ipdb(2)) = ipdb(5)
         iconn(1,ipdb(5)) = 1
         iconn(2,ipdb(5)) = ipdb(2)
      endif
 
      if (icres.le.numcal) then
         icalf(1,icres) = ipdb(2)
         icalf(2,icres) = ipdb(1)
         icalf(3,icres) = ipdb(3)
         icalf(4,icres) = 0
      endif

      if (icres.gt.1.and.icres.le.numcal) then
         newch = .false.
         ic = icalf(3,icres-1)
         in = ipdb(1)
         if (iamino(icres-1).le.23.and.(ic.gt.0.and.in.gt.0)) then
            do i=1,3
               tmp(i) = coo(i,in) - coo(i,ic)
            end do
            distsq = tmp(1)*tmp(1) + tmp(2)*tmp(2) +
     &               tmp(3)*tmp(3)
            if (distsq.lt.3.1684d0*fct) then
c
c connect N current residue to C previous
c
               iconn(1,in) = iconn(1,in) + 1 
               iconn(iconn(1,in)+1,in) = ic
c
c connect C previous to N current residue 
c
               iconn(1,ic) = iconn(1,ic) + 1 
               iconn(iconn(1,ic)+1,ic) = in
            else
               newch = .true.
            endif
         else 
            newch = .true.
         endif

         if (newch.and.idoconv.eq.0) then
            if (nchain.lt.mxchai) then
               islu(nchain) = icres-1
               nchain = nchain + 1
               ianf(nchain) = icres
            endif
         endif

      endif

      if (ihashy.eq.1) then
          do i=1,3
             call conath(ipdb,ihpdb,1,i)
             call conath(ipdb,ihpdb,2,3+i)
             call conath(ipdb,ihpdb,5,6+i)
          end do
          call conath(ipdb,ihpdb,1,79)
          call conath(ipdb,ihpdb,1,82)
          call conath(ipdb,ihpdb,1,91)
      endif

      return
      end

      subroutine detanz(resi,tstr,lstr,ifnd,ish,ianz,ihashy)
      implicit double precision (a-h,o-z)
      parameter (mxel=100)
      character*2 elemnt
      common /elem/elemnt(mxel)
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character lstr*137
      character*3 resi, atmp
      character*4 tstr
      character*2 tocapf

          ifnd = 1
          ish = 0
          atmp = tstr(2:4)
c
c Take care of ambiguity; asx->asn ,glx->gln ,his
c
          if (resi.eq.'ASX') then
              if (atmp.eq.'AD1') then
                  atmp = 'OD1'
              elseif (atmp.eq.'AD2') then
                  atmp = 'ND2'
              endif
          elseif (resi.eq.'GLX') then
              if (atmp.eq.'AE1') then
                  atmp = 'OE1'
              elseif (atmp.eq.'AE2') then
                  atmp = 'NE2'
              endif
          elseif (resi.eq.'HIS') then
              if (atmp.eq.'AD1') then
                  atmp = 'ND1'
              elseif (atmp.eq.'AD2') then
                  atmp = 'CD2'
              elseif (atmp.eq.'AE1') then
                  atmp = 'CE1'
              elseif (atmp.eq.'AE2') then
                  atmp = 'NE2'
              endif
          elseif (resi.eq.'ILE') then
              if (atmp.eq.'CD ') then
                  atmp = 'CD1'
              elseif (atmp.eq.'HD1') then
                  atmp = 'HD1'
                  tstr(1:4) = '1HD1'
              elseif (atmp.eq.'HD2') then
                  atmp = 'HD1'
                  tstr(1:4) = '2HD1'
              elseif (atmp.eq.'HD3') then
                  atmp = 'HD1'
                  tstr(1:4) = '3HD1'
              endif
          elseif (resi.eq.'SER'.or.resi.eq.'CYS') then
              if (atmp.eq.'HG1') atmp = 'HG '
          elseif (resi.eq.'  T'.or.resi.eq.' DT') then
              if (atmp(1:2).eq.'H7') atmp = 'HM7'
          endif
          if (atmp.ne.tstr(2:4)) tstr(2:4) = atmp


          if (tstr(1:2).eq.'HH'.or.tstr(1:2).eq.'HD'.or.
     &        tstr(1:2).eq.'HE'.or.tstr(1:2).eq.'HG') then
              atmp = tstr(1:3)
              tstr = ' '//atmp
          endif

c to unscrew whatif specific types

          if (tstr(2:4).eq.'O**') tstr(2:4) = 'OXT'
          if (tstr(2:4).eq.'O* ') tstr(2:4) = 'O  '
          if (tstr(2:4).eq.'H5M') tstr(2:4) = 'HM5'
          if (tstr(2:4).eq.'H3T') tstr(2:4) = 'HO3'
          if (tstr(1:4).eq.'1H4 ') tstr(1:4) = ' H41'
          if (tstr(1:4).eq.'2H4 ') tstr(1:4) = ' H42'

          if (tstr(2:4).eq.'OT1') tstr(2:4) = 'O  '
          if (tstr(2:4).eq.'OT2') tstr(2:4) = 'OXT'

          it = ichar(tstr(2:2))
          it4 = ichar(tstr(4:4))
          if (it.eq.67) then
             ianz = 6
          elseif (it.eq.78) then
             ianz = 7
          elseif (it.eq.79) then
             ianz = 8
          elseif (it.eq.80) then
             ianz = 15
          elseif (it.eq.83) then
             ianz = 16
          elseif (it.eq.72.or.it.eq.68) then
             ianz = 1
             if (it.eq.68) tstr(2:2) = 'H'
             if (tstr(2:4).eq.'HN ') tstr(2:4) = 'H  '
             if ((tstr(2:3).eq.'HA'.or.tstr(2:3).eq.'HB').and.
     &           (tstr(4:4).ne.' ')) tstr(4:4) = ' '
             if (tstr(2:3).eq.'HT'.and.(it4.ge.49.and.it4.le.51))
     &       then
                tstr(3:4) = '  '
                tstr(1:1) = tstr(4:4)
             endif
             ihashy = 1
             ish = 1
c Below convert 1H8 to H81, which not recognized by molden
c it probably served to read in force field H label variant
c             if (tstr(4:4).eq.' ') then
c                it1 = ichar(tstr(1:1))
c                it3 = ichar(tstr(3:3))
c                if ((it1.ge.49.and.it1.le.57).and.
c     &              (it3.ge.49.and.it3.le.57)) tstr(4:4) = tstr(1:1)
c             endif
          else
             ifnd = 0 
          endif
          
          if (ifnd.eq.0) then
            it = ichar(tstr(1:1))
            if (.not.(it.ge.65.and.it.le.90).and..not.
     &             (it.ge.97.and.it.le.122)) tstr(1:1) = ' '
            do j=1,99
             if (tstr(1:2).eq.tocapf(elemnt(j))) ianz = j
            end do
            if (ianz.eq.0.and.tstr(1:1).ne.' ') then
               tstr(1:1) = ' '
               do j=1,99
                  if (tstr(1:2).eq.tocapf(elemnt(j))) 
     &                ianz = j
               end do
            endif
            if (ianz.le.0) then
               if (tstr(2:2).eq.'D'.and.tstr(2:3).ne.'DY') then
                  ianz = 1
               else
                  write(iun3,*) 'Unclassified atom =',tstr
                  write(iun3,*) lstr
                  ianz = 99
               endif
            endif
          endif

      return
      end

      subroutine chkcap(irs,iterm,iconn,ianz,iresid,qat,
     &                  icalf,iamino)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      parameter (mxcon=10)
      common /athlp/ iatoms, mxnat
      common /conrl/ ibnds,icnn(mxcon),io,in,ic,ih,ian1,ian2,ian3,ian4
      dimension iconn(mxcon+1,*),ianz(*),iresid(*),qat(*)
      dimension nace(6),qace(6),nme(6),qnme(6),qnh2(3)
      dimension icalf(6,*),iamino(*)
      data qace /0.59720,-0.56790,-0.36620,0.11230,0.11230,0.11230/
      data qnme /-0.41570,0.27190,-0.14900,0.09760,0.09760,0.09760/
      data qnh2 /-0.46300,0.23150,0.23150/

      if (iterm.eq.1) then
         ncterm = icalf(2,irs)
      else
         ncterm = icalf(3,irs)
      endif

      call getrcn(ncterm,iconn,ianz)

      if (iterm.eq.1) then
c N-term
c        establish carbonyl C of ACE

         do i=1,6
             nace(i) = 0
         end do

         iace = 0
         if ((ic.eq.2.and.iamino(irs).ne.15).or.
     &       (ic.eq.3.and.iamino(irs).eq.15)) then
             
             do i=1,ibnds
                if (ianz(icnn(i)).eq.6.and.iresid(icnn(i)).ne.irs)
     &            iace = icnn(i)
             end do
             if (iace.eq.0) return

         else
            return
         endif

         nace(1) = iace
         call getrcn(iace,iconn,ianz)
         if (io.eq.1) then
             do i=1,ibnds
                if (ianz(icnn(i)).eq.8) nace(2) = icnn(i)
             end do
         else
             return
         endif

         if (ic.eq.1) then
             do i=1,ibnds
                if (ianz(icnn(i)).eq.6) nace(3) = icnn(i)
             end do
         else
             return
         endif

         call getrcn(nace(3),iconn,ianz)
         if (ih.eq.3) then
             itel = 4
             do i=1,ibnds
                if (ianz(icnn(i)).eq.1) then
                    nace(itel) = icnn(i)
                    itel = itel + 1
                endif
             end do
         else
             return
         endif

c        check if all atoms ACE found

         do i=1,6
            if (nace(i).le.0) return
         end do

         do i=1,6
            qat(nace(i)) = qace(i)
         end do

      else

c C-term
c        establish n-methyl N of NME/NH2

         do i=1,6
             nme(i) = 0
         end do

         inme = 0

         if (in.eq.1) then
             
             do i=1,ibnds
                if (ianz(icnn(i)).eq.7.and.iresid(icnn(i)).ne.irs)
     &            inme = icnn(i)
             end do
             if (inme.eq.0) return

         else
            return
         endif

         nme(1) = inme
         inh2 = 0
         call getrcn(inme,iconn,ianz)
         if (ih.eq.1) then
             do i=1,ibnds
                if (ianz(icnn(i)).eq.1) nme(2) = icnn(i)
             end do
         else if (ih.eq.2) then
             inh2 = 1
             itel = 0
             do i=1,ibnds
                if (ianz(icnn(i)).eq.1) then
                   nme(2+itel) = icnn(i)
                   itel = itel + 1
                endif
             end do
         else
             return
         endif

         if (inh2.eq.1) then

c           this is NH2 cap

            do i=1,3
               if (nme(i).le.0) return
            end do

            do i=1,3
               qat(nme(i)) = qnh2(i)
            end do

            return
         endif

c        this is NME cap

         if (ic.eq.2) then
             do i=1,ibnds
                if (ianz(icnn(i)).eq.6.and.iresid(icnn(i)).ne.irs) 
     &             nme(3) = icnn(i)
             end do
         else
             return
         endif

         call getrcn(nme(3),iconn,ianz)
         if (ih.eq.3) then
             itel = 4
             do i=1,ibnds
                if (ianz(icnn(i)).eq.1) then
                    nme(itel) = icnn(i)
                    itel = itel + 1
                endif
             end do
         else
             return
         endif

c        check if all atoms NME found

         do i=1,6
            if (nme(i).le.0) return
         end do

         do i=1,6
            qat(nme(i)) = qnme(i)
         end do

      endif

      return
      end

      subroutine getrcn(iat,iconn,ianz)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      parameter (mxcon=10)
      common /conrl/ ibnds,icnn(mxcon),io,in,ic,ih,ian1,ian2,ian3,ian4
      dimension iconn(mxcon+1,*),ianz(*)

      ibnds = 0
      io = 0
      in = 0
      ic = 0
      ih = 0
      ian1 = 0
      ian2 = 0
      ian3 = 0
      ian4 = 0

      if (iat.eq.0) return

      do i=1,iconn(1,iat)
         if (iconn(i+1,iat).gt.0) then
            ibnds = ibnds + 1
            icnn(ibnds) = iconn(i+1,iat)
            ia = ianz(icnn(ibnds))
            if (ia.eq.1) ih = ih + 1
            if (ia.eq.6) ic = ic + 1
            if (ia.eq.7) in = in + 1
            if (ia.eq.8) io = io + 1
         endif
      end do

      if (ibnds.gt.0) ian1 = ianz(icnn(1))
      if (ibnds.gt.1) ian2 = ianz(icnn(2))
      if (ibnds.gt.2) ian3 = ianz(icnn(3))
      if (ibnds.gt.4) ian4 = ianz(icnn(4))

      return
      end

      integer function igtyp(iat,ian,idochg,ianz,iconn)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      parameter (mxcon=10)
      parameter (mxt=14)
      character*4 atype
      common /atypes/ ihbt(mxt),atype(mxt)
      dimension icnn(mxcon),iccn(mxcon),icnn2(mxcon),iconn(mxcon+1,*),
     &          ianz(*)

      ibnds = 0
      ih = 0
      ihc = 0
      io = 0
      in = 0
      ic = 0
      is = 0
      ian1 = 0
      ian2 = 0
      ian3 = 0

      do i=1,mxcon
         icnn(i) = 0
         iccn(i) = 0
      end do

      do i=1,iconn(1,iat)
         if (iconn(i+1,iat).gt.0) then
            ibnds = ibnds + 1
            icnn(ibnds) = iconn(i+1,iat)
            ia = ianz(icnn(ibnds))
            if (ia.eq.1) ih = ih + 1
            if (ia.eq.6) ic = ic + 1
            if (ia.eq.6.or.ia.eq.1) ihc = ihc + 1
            if (ia.eq.7) in = in + 1
            if (ia.eq.8) io = io + 1
            if (ia.eq.16) is = is + 1
         endif
      end do
      if (ibnds.gt.0) ian1 = ianz(icnn(1))
      if (ibnds.gt.1) ian2 = ianz(icnn(2))
      if (ibnds.gt.2) ian3 = ianz(icnn(3))

      call ispn(irs,iat,irng,idochg,1)
      
c irs    1      2      3      4      5      6       7
c      '    ','.1  ','.2  ','.3  ','.4  ','.ar ','.cat'
c irs    8      9     10     11     12     13      14
c      '.am ','.pl3','.co2','.spc','.t3p','.O  ','.O2 '

      igtyp = 1
      if (ian.eq.1) then

         igtyp = 1
         if (ibnds.eq.1) then
            if (ian1.eq.6) then
               igtyp = 25
               call ispn(itmp,icnn(1),irng,idochg,1)
               if (itmp.eq.6.or.itmp.eq.3) igtyp = 24

               call flth(icnn(1),icnn2,ibnds2,iconn)

               nhcp = 0
               do i=1,ibnds2
                   ia = ianz(icnn2(i))
                   if (.not.(ia.eq.6.or.ia.eq.1.or.ia.eq.15)) then
                      nhcp = nhcp + 1
                      iccn(nhcp) = icnn2(i)
                   endif
               end do

               if (nhcp.ne.0) then
                  if (igtyp.eq.25) then
                     igtyp = 18 + nhcp
                  elseif (igtyp.eq.24) then
                     igtyp = 21 + nhcp
                  endif
               endif
               if (nhcp.eq.1.and.(iccn(1).gt.1.and.icnn(1).lt.100)) 
     &         then
                  if (ianz(iccn(1)).eq.8.and.
     &               (itmp.eq.6.or.itmp.eq.3)) then
                     igtyp = 24
                  endif
               endif
            endif
            if (ian1.eq.7)  igtyp = 26
            if (ian1.eq.8)  then
               igtyp = 27
               call flth(icnn(1),icnn2,ibnds2,iconn)
               if (ibnds2.eq.2) then
                  if (ianz(icnn2(1)).eq.1.and.ianz(icnn2(2)).eq.1)
     &               igtyp = 30
               endif
            endif
            if (ian1.eq.15) igtyp = 28
            if (ian1.eq.16) igtyp = 29
         endif

      elseif (ian.eq.6) then

         if (irs.eq.2) igtyp = 3
         if (irs.eq.3) igtyp = 4
         if (irs.eq.4) igtyp = 5
         if (irs.eq.6) igtyp = 6
         if (irs.eq.7) then
            igtyp = 6
            if (in.eq.3) igtyp = 72
         endif

         if ((irs.eq.3.or.irs.eq.6).and.ibnds.eq.3.and.
     &      (io.ge.1.or.is.ge.1)) then
            icon = 0
            if (ian1.eq.8.or.ian1.eq.16) icon = icnn(1)
            if (ian2.eq.8.or.ian2.eq.16) icon = icnn(2)
            if (ian3.eq.8.or.ian3.eq.16) icon = icnn(3)
            if (icon.gt.0) then
               call ispn(itmp,icon,irng,idochg,1)
               if ((itmp.eq.10.or.itmp.eq.3).and.irng.le.0) igtyp = 2
            endif
         endif

      elseif (ian.eq.7) then

c n1     (.1)
         if (irs.eq.2) igtyp = 37
c n2, nc (.2,.ar) (nc contributes 1 el to pi system)
         if ((irs.eq.3.or.irs.eq.6).and.ibnds.eq.2) then
            igtyp = 38
            if (irs.eq.6) igtyp = 43
         endif
c na     (.2,.ar,.pl) (.pl contributes 2 el to pi system)
         if ((irs.eq.3.or.irs.eq.6.or.irs.eq.9).and.ibnds.eq.3) 
     &      igtyp = 41
c n3     (.3)
         if (irs.eq.4.and.ibnds.eq.3) igtyp = 39
c no     (.2,.3,.pl)
         if ((irs.eq.3.or.irs.eq.4.or.irs.eq.9).and.
     &      ibnds.eq.3.and.io.eq.2) igtyp = 48
c n4     (.4)
         if (irs.eq.5) igtyp = 40
c n      (.am)
         if (irs.eq.8) igtyp = 36
c nh     (.3)
         if ((irs.eq.4.or.irs.eq.9).and.ibnds.eq.3.and.ihc.eq.3) then
            iar = 0
            if (ian1.ne.1) then
               call ispn(itmp,icnn(1),irng,idochg,1)
               if (itmp.eq.6) iar = iar + 1
            endif
            if (ian2.ne.1) then
               call ispn(itmp,icnn(2),irng,idochg,1)
               if (itmp.eq.6) iar = iar + 1
            endif
            if (ian3.ne.1) then
               call ispn(itmp,icnn(3),irng,idochg,1)
               if (itmp.eq.6) iar = iar + 1
            endif
            if (iar.gt.0) igtyp = 47
         endif
         if (ibnds.eq.3.and.ic.gt.0) then
            do i=1,ibnds
               nat = ianz(icnn(i))
               if (nat.eq.6) then
                  call flth(icnn(i),icnn2,ibnds2,iconn)
                  if (ibnds2.eq.3) then
                      iscat = 1
                      do j=1,3
                         if (ianz(icnn2(j)).ne.7) iscat = 0
                      end do
                      if (iscat.eq.1) igtyp = 47
                  endif
               endif
            end do
         endif

      elseif (ian.eq.8) then

         if (irs.eq.3.or.irs.eq.10) igtyp = 49
         if ((irs.eq.4.or.irs.eq.6).and.ibnds.eq.2) then
            if (ih.eq.2) then 
               igtyp = 52
            elseif (ih.eq.1) then
               igtyp = 50
            else
               igtyp = 51
            endif
         endif

      elseif (ian.eq.15) then

         if (ibnds.le.2) igtyp = 53
         if (ibnds.eq.3) then

c difference between p3 and p4 may need some adjustment

            iar = 0
            if (ian1.ne.1) then
               call ispn(itmp,icnn(1),irng,idochg,1)
               if (itmp.eq.3) iar = iar + 1
            endif
            if (ian2.ne.1) then
               call ispn(itmp,icnn(2),irng,idochg,1)
               if (itmp.eq.3) iar = iar + 1
            endif
            if (ian3.ne.1) then
               call ispn(itmp,icnn(3),irng,idochg,1)
               if (itmp.eq.3) iar = iar + 1
            endif
            if (iar.gt.0) then
               igtyp = 55
            else
               igtyp = 54
            endif
         endif
         if (ibnds.ge.4) igtyp = 56

      elseif (ian.eq.16) then

         if (ibnds.eq.1) igtyp = 64
c ibnds = 2 may need some refinement, sh clear, ss clear, but s2 ?
         if (ibnds.eq.2) then
            if (ih.ge.1) then
               igtyp = 68
            else
               if ((irs.eq.4.or.irs.eq.6).or.is.eq.1) then
                  igtyp = 69
               else
                  igtyp = 65
               endif
            endif
         endif
         if (ibnds.eq.3) igtyp = 66
         if (ibnds.ge.4) igtyp = 67

      elseif (ian.eq.9) then
         if (ibnds.eq.1) igtyp = 32
      elseif (ian.eq.17) then
         if (ibnds.eq.1) igtyp = 33
      elseif (ian.eq.35) then
         if (ibnds.eq.1) igtyp = 34
      elseif (ian.eq.53) then
         if (ibnds.eq.1) igtyp = 35
      endif
      
      return
      end

      subroutine mkbadd(ipdb,ihpdb,jres,icres,ihashy,idoconv,
     &                  iconn,coo,
     &                  icalf,ianf,islu,nchain,iamino)

      implicit double precision (a-h,o-z)
      parameter (numcal=50000)
      parameter (mxchai=50)
      parameter (mxcon=10)
      logical newch
      dimension ipdb(*),ihpdb(*),tmp(3),coo(3,*),iconn(mxcon+1,*)
      dimension icalf(6,*),ianf(*),islu(*),iamino(*)

      fct = 1.0d0
      if (idoconv.eq.1) fct = 1.0d0 / (0.52917706d0*0.52917706d0)

c N-CA
      if (ipdb(1).ne.0.and.ipdb(2).ne.0) then
         iconn(1,ipdb(1)) = 1
         iconn(2,ipdb(1)) = ipdb(2)
      endif

c CA-N, CA-C
      if (ipdb(2).ne.0) then
         iconn(1,ipdb(2)) = 0
         if (ipdb(1).ne.0) then
            iconn(2,ipdb(2)) = ipdb(1)
            iconn(1,ipdb(2)) = 1
            if (ipdb(3).ne.0) then
               iconn(3,ipdb(2)) = ipdb(3)
               iconn(1,ipdb(2)) = 2
            endif
         else
            if (ipdb(3).ne.0) then
               iconn(2,ipdb(2)) = ipdb(3)
               iconn(1,ipdb(2)) = 1
            endif
         endif
      endif

c C-CA,C-O
      if (ipdb(4).ne.0.and.ipdb(3).ne.0) then
         iconn(1,ipdb(3)) = 0
         if (ipdb(2).ne.0) then
            iconn(2,ipdb(3)) = ipdb(2)
            iconn(3,ipdb(3)) = ipdb(4)
            iconn(1,ipdb(3)) = 2
         else
            iconn(2,ipdb(3)) = ipdb(4)
            iconn(1,ipdb(3)) = 1
         endif
c O-C
         iconn(1,ipdb(4)) = 1
         iconn(2,ipdb(4)) = ipdb(3)

      elseif (ipdb(3).ne.0.and.ipdb(2).ne.0) then
         iconn(1,ipdb(3)) = 1
         iconn(2,ipdb(3)) = ipdb(2)
      elseif (ipdb(3).ne.0) then
         iconn(1,ipdb(3)) = 0
      elseif (ipdb(4).ne.0) then
         iconn(1,ipdb(4)) = 0
      endif


c Possible OXT
      if (ipdb(38).ne.0.or.ipdb(76).ne.0) then
         if (ipdb(38).ne.0) then
            iox = ipdb(38)
         else
            iox = ipdb(76)
         endif
         iconn(1,ipdb(3)) = iconn(1,ipdb(3)) + 1
         iconn(iconn(1,ipdb(3))+1,ipdb(3)) = iox
         iconn(1,iox) = 1
         iconn(2,iox) = ipdb(3)
      endif
c C beta
      if (jres.gt.1.and.ipdb(5).ne.0) then
         iconn(1,ipdb(2)) = 3
         iconn(4,ipdb(2)) = ipdb(5)
         iconn(1,ipdb(5)) = 1
         iconn(2,ipdb(5)) = ipdb(2)
      endif
 
      if (icres.le.numcal) then
         icalf(1,icres) = ipdb(2)
         icalf(2,icres) = ipdb(1)
         icalf(3,icres) = ipdb(3)
         icalf(4,icres) = 0
      endif

      if (icres.gt.1.and.icres.le.numcal) then
         newch = .false.
         ic = icalf(3,icres-1)
         in = ipdb(1)
         if (iamino(icres-1).le.23.and.(ic.gt.0.and.in.gt.0)) then
            do i=1,3
               tmp(i) = coo(i,in) - coo(i,ic)
            end do
            distsq = tmp(1)*tmp(1) + tmp(2)*tmp(2) +
     &               tmp(3)*tmp(3)
            if (distsq.lt.3.1684d0*fct) then
c
c connect N current residue to C previous
c
               iconn(1,in) = iconn(1,in) + 1 
               iconn(iconn(1,in)+1,in) = ic
            else
               newch = .true.
            endif
         else 
            newch = .true.
         endif

         if (newch.and.idoconv.eq.0) then
            if (nchain.lt.mxchai) then
               islu(nchain) = icres-1
               nchain = nchain + 1
               ianf(nchain) = icres
            endif
         endif

      endif

      if (icres.ge.1.and.icres.le.numcal-1) then
         ic = ipdb(3)
         in = icalf(2,icres+1)
         if (iamino(icres+1).le.23.and.(ic.gt.0.and.in.gt.0)) then
            do i=1,3
               tmp(i) = coo(i,in) - coo(i,ic)
            end do
            distsq = tmp(1)*tmp(1) + tmp(2)*tmp(2) +
     &               tmp(3)*tmp(3)
            if (distsq.lt.3.1684d0*fct) then
c
c connect C previous to N current residue 
c
               iconn(1,ic) = iconn(1,ic) + 1 
               iconn(iconn(1,ic)+1,ic) = in
            endif
         endif

      endif

      if (ihashy.eq.1) then
          do i=1,3
             call conath(ipdb,ihpdb,1,i)
             call conath(ipdb,ihpdb,2,3+i)
             call conath(ipdb,ihpdb,5,6+i)
          end do
          call conath(ipdb,ihpdb,1,79)
          call conath(ipdb,ihpdb,1,82)
          call conath(ipdb,ihpdb,1,91)
      endif

      return
      end

      subroutine setchd(iat,iopt,qat,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxamb=1590)
      parameter (mxgff=72)
      parameter (mxambc=49)
      common /charge/ ihasq
      integer ambvdt
      common /fcharg/ ambchg(mxamb),ambvw1(mxambc),ambvw2(mxambc),
     &                gfvdw(2,mxgff),ambvdt(mxamb),cysneg(9)
      dimension qat(*),ityp(*)

      if (iat.gt.0) then
         if (iopt.eq.1) then
            it = ityp(iat)
            if (it.gt.0) then
               qat(iat) = ambchg(int(it))
            endif
            ihasq = 1
         elseif (iopt.eq.0) then
            qat(iat) = 0.0d0
         elseif (iopt.lt.0) then
            qat(iat) = cysneg(abs(iopt))
         endif
      endif

      return
      end

      subroutine settyp(itypa,iat,ityp)
      implicit double precision (a-h,o-z)
      dimension itypa(*)

      if (iat.gt.0) then
          itypa(iat) = ityp
      endif

      return
      end

      subroutine typamd(ipdb,jres,ihpdb,ihashy,
     &                  ianz,iconn,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxres=42)
      parameter (mxrss=20)
      parameter (mxrsa=23)
      parameter (mxata=9)
      parameter (mxatha=9)
      parameter (mxrso=24)
      parameter (mxato=10)
      parameter (mxatho=11)
      parameter (mxrsn=19)
      parameter (mxnucl=39)
      parameter (mxhnuc=27)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxamb=1590)
      parameter (mxgff=72)
      parameter (mxambc=49)
      logical nterm,cterm
      common /types/ iff
      common /athlp/ iatoms, mxnat
      integer amboff,ntca,ctca
      common /ambtyp/ amboff(mxrss*3),ntca(mxrss),ctca(mxrss),
     &                ncca(mxrsa),icca(2,mxata,mxrsa),
     &                nhha(mxrsa),ihha(2,mxatha,mxrsa),
     &                ncco(mxrso),icco(2,mxato,mxrso),
     &                nhho(mxrso),ihho(2,mxatho,mxrso),
     &                nnuc(mxrsn),nhnuc(mxrsn),irna(mxres-23),
     &                inuc(2,mxnucl,mxrsn),ihnuc(2,mxhnuc,mxrsn)
      integer ambvdt
      common /fcharg/ ambchg(mxamb),ambvw1(mxambc),ambvw2(mxambc),
     &                gfvdw(2,mxgff),ambvdt(mxamb),cysneg(9)
      logical ismet

      dimension ipdb(*), ihpdb(*),ianz(*),iconn(mxcon+1,*),ityp(*),
     &          icn(4)

      iff = 3

c     currently only works for aminoacids, not nucleic acids 
c     (mxrss=20) (HIP,HID,HIE and sulfer bridge covered)
c                (ORN, mALA and pyroglut not covered)


      if (jres.le.0.or.jres.gt.mxres) return
      if (jres.gt.mxrss) goto 100

      do i=1,mxsym
         call settyp(ityp,ipdb(i),0)
         call setchg(ipdb(i),0)
      end do
      do i=1,mxhsym*3
         call settyp(ityp,ihpdb(i),0)
         call setchg(ihpdb(i),0)
      end do

      nterm = .false.
      n = 0
      do i=1,3
         if (ihpdb(i).ne.0) n = n + 1
      end do
      if (n.eq.0) then
         if (ihpdb(79).ne.0) n = n + 1
         if (ihpdb(82).ne.0) n = n + 1
         if (ihpdb(91).ne.0) n = n + 1
      endif
      if (n.eq.3.or.(jres.eq.15.and.n.eq.2)) nterm = .true.
      cterm = .false.
      if (ipdb(38).ne.0) cterm = .true.

      if (jres.eq.17) then
c ihis
c 
c  1  HIS+ (HIP)
c  2  HISD (HID)
c  3  HISE (HIE)
c
         ihis = 1
         if (ihashy.eq.1) then
            if (ihpdb(34).eq.0) ihis = 2
            if (ihpdb(22).eq.0) ihis = 3
         endif
      endif

      if (jres.eq.4) then
c iss = 0 (cysteine -SH), iss = 1 (cystine -SS-)
         iss = 0
         if (ipdb(37).ne.0) then
            do i=1,iconn(1,ipdb(37))
               if (ianz(abs(iconn(1+i,ipdb(37)))).eq.16) 
     &             iss = 1
            end do
         endif
      endif

      if (nterm) then
          ioff = amboff(jres+20)
      else if(cterm) then
          ioff = amboff(jres+40)
      else
        ioff = amboff(jres)
      endif

      if (jres.eq.17) then
         if (ihis.eq.2) ioff = 178
         if (ihis.eq.3) ioff = 194
      endif

      if (jres.eq.4.and.iss.eq.1) ioff = 87
      if (jres.eq.9.and.(ihpdb(22).ne.0.or.ihpdb(25).ne.0)) ioff = 660
      if (jres.eq.13.and.(ihpdb(31).ne.0.or.ihpdb(34).ne.0)) ioff = 672

      ihtot = 0
      do i=0,2
         if (ihpdb(40+i).ne.0) ihtot = ihtot + 1
      end do

      if (jres.eq.12.and.ihtot.eq.2) ioff = 686

      if (nterm) then
         if (jres.eq.17 .and. ihis.eq.2) ioff = 436
         if (jres.eq.17 .and. ihis.eq.3) ioff = 442
         if (jres.eq.4 .and. iss.eq.1) ioff = 398
      endif
      if (cterm) then
         if (jres.eq.17 .and. ihis.eq.2) ioff = 584
         if (jres.eq.17 .and. ihis.eq.3) ioff = 590
         if (jres.eq.4 .and. iss.eq.1) ioff = 549
      endif

      call settyp(ityp,ipdb(1),ioff)
      call settyp(ityp,ipdb(2),ioff+1)
      call settyp(ityp,ipdb(3),ioff+2)

      if (jres.eq.15.and..not.nterm) then
         call settyp(ityp,ipdb(4),ioff+3)
         if (cterm) call settyp(ityp,ipdb(38),ioff+3)
      else
         call settyp(ityp,ipdb(4),ioff+4)
         if (cterm) call settyp(ityp,ipdb(38),ioff+4)
      endif

      call settyp(ityp,ihpdb(1),ioff+3)
      call settyp(ityp,ihpdb(2),ioff+3)
      call settyp(ityp,ihpdb(3),ioff+3)
      call settyp(ityp,ihpdb(79),ioff+3)
      call settyp(ityp,ihpdb(82),ioff+3)
      call settyp(ityp,ihpdb(91),ioff+3)

      if (jres.eq.15) then
         if (nterm) then
            call settyp(ityp,ihpdb(4),409)
         else
            call settyp(ityp,ihpdb(4),ioff+4)
            call settyp(ityp,ihpdb(5),ioff+4)
         endif
      else
         call settyp(ityp,ihpdb(4),ioff+5)
         call settyp(ityp,ihpdb(5),ioff+5)
      endif

      if (nterm.or.cterm) then
         ioff = amboff(jres)
         if (jres.eq.17) then
            if (ihis.eq.2) ioff = 178
            if (ihis.eq.3) ioff = 194
         endif
         if (jres.eq.4.and.iss.eq.1) ioff = 87
      endif

      if (jres.eq.15) then
         call settyp(ityp,ipdb(5),ioff+5)
         call settyp(ityp,ihpdb(7),ioff+6)
         call settyp(ityp,ihpdb(8),ioff+6)
         call settyp(ityp,ihpdb(9),ioff+6)
      else
         call settyp(ityp,ipdb(5),ioff+6)
         call settyp(ityp,ihpdb(7),ioff+7)
         call settyp(ityp,ihpdb(8),ioff+7)
         call settyp(ityp,ihpdb(9),ioff+7)
      endif

      jtmp = jres
      if (jres.eq.17) then
         if (ihis.eq.2) jtmp = 22
         if (ihis.eq.3) jtmp = 23
      endif
      if (jres.eq.4.and.iss.eq.1) jtmp = 21
    
      do i=1,ncca(jtmp)
         call settyp(ityp,ipdb(icca(1,i,jtmp)),icca(2,i,jtmp))
      end do

      do i=1,nhha(jtmp)
         call settyp(ityp,ihpdb(ihha(1,i,jtmp)),ihha(2,i,jtmp))
      end do

      if (jres.eq.8) then
         call settyp(ityp,ihpdb(13),267)
         call settyp(ityp,ihpdb(16),267)
         call settyp(ityp,ihpdb(31),270)
         call settyp(ityp,ihpdb(34),270)
         call settyp(ityp,ihpdb(37),270)
      endif
      if (jres.eq.13) then
         call settyp(ityp,ihpdb(13),241)
         call settyp(ityp,ihpdb(16),241)
      endif
      if (jres.eq.14) then
         call settyp(ityp,ihpdb(13),253)
         call settyp(ityp,ihpdb(16),253)
      endif
      if (jres.eq.16) then
         call settyp(ityp,ihpdb(13),296)
         call settyp(ityp,ihpdb(16),296)
         call settyp(ityp,ihpdb(22),298)
         call settyp(ityp,ihpdb(25),298)
      endif

      if (jres.eq.15) then
         if (nterm) then
            call settyp(ityp,ipdb(9),410)
            call settyp(ityp,ihpdb(19),411)
            call settyp(ityp,ihpdb(20),411)
         endif
      endif

c check for lysine alternative HZ1,HZ2,HZ3 instead of 1HZ,2HZ,3HZ

      if (jres.eq.12) then
         call settyp(ityp,ihpdb(13),280)
         call settyp(ityp,ihpdb(16),280)
         call settyp(ityp,ihpdb(22),282)
         call settyp(ityp,ihpdb(25),282)
         call settyp(ityp,ihpdb(34),284)
         call settyp(ityp,ihpdb(37),284)
         call settyp(ityp,ihpdb(43),286)
         call settyp(ityp,ihpdb(46),286)
         call settyp(ityp,ihpdb(49),286)
      endif

c check asph, RECTIFICATION: asph, gluh neutral lys, neg cys
c are not in the tinker amber set.
c we could add our own, but it has not been done yet
c Original AMBER itself does not work with so many atom types.
c Tinker creates the extra atom types to incrporate the charges
c in there as well. Charges deviate slightly between
c cterm,nterm and regular residues
c see ~schaft/compile/linux/molden4.6/
c     forf/amber9.ffparms/dat/leap/prep/all_amino94.in
c for the charges
c we should add our own extra types for these residues

      if (jres.eq.9) then
         if (ihpdb(22).ne.0) then
            call settyp(ityp,ipdb(6),668)
            call settyp(ityp,ipdb(29),670)
            call settyp(ityp,ipdb(30),669)
            call settyp(ityp,ihpdb(22),671)
         endif
         if (ihpdb(25).ne.0) then
            call settyp(ityp,ipdb(6),668)
            call settyp(ityp,ipdb(29),669)
            call settyp(ityp,ipdb(30),670)
            call settyp(ityp,ihpdb(25),671)
         endif
      endif

      if (jres.eq.13) then
         if (ihpdb(31).ne.0) then
            call settyp(ityp,ipdb(6),680)
            call settyp(ityp,ipdb(9),682)
            call settyp(ityp,ipdb(34),684)
            call settyp(ityp,ipdb(35),683)
            call settyp(ityp,ihpdb(10),681)
            call settyp(ityp,ihpdb(11),681)
            call settyp(ityp,ihpdb(31),685)
         endif
         if (ihpdb(34).ne.0) then
            call settyp(ityp,ipdb(6),680)
            call settyp(ityp,ipdb(9),682)
            call settyp(ityp,ipdb(34),683)
            call settyp(ityp,ipdb(35),684)
            call settyp(ityp,ihpdb(10),681)
            call settyp(ityp,ihpdb(11),681)
            call settyp(ityp,ihpdb(34),685)
         endif
      endif

      if (jres.eq.12.and.ihtot.eq.2) then
            call settyp(ityp,ipdb(6),694)
            call settyp(ityp,ipdb(9),696)
            call settyp(ityp,ipdb(12),698)
            call settyp(ityp,ipdb(27),700)
            call settyp(ityp,ihpdb(10),695)
            call settyp(ityp,ihpdb(11),695)
            call settyp(ityp,ihpdb(19),697)
            call settyp(ityp,ihpdb(20),697)
            call settyp(ityp,ihpdb(28),699)
            call settyp(ityp,ihpdb(29),699)
            call settyp(ityp,ihpdb(40),701)
            call settyp(ityp,ihpdb(41),701)
            call settyp(ityp,ihpdb(42),701)
            call settyp(ityp,ihpdb(43),701)
            call settyp(ityp,ihpdb(46),701)
            call settyp(ityp,ihpdb(49),701)
      endif

      do i=1,mxsym
         call setchg(ipdb(i),1)
      end do
      do i=1,mxhsym*3
         call setchg(ihpdb(i),1)
      end do

      if (jres.eq.4) then

c ic = 0 (negative cysteine), apply different charges

         if (ipdb(37).ne.0) then
            ic = 0
            do i=1,iconn(1,ipdb(37))
               ii = iconn(1+i,ipdb(37))
               if (ii.gt.0.and.ii.ne.ipdb(5)) then
                   if (.not.ismet(ianz(ii))) ic = ic + 1
               endif
            end do

            if (ic.eq.0) then

               do i=1,mxsym
                  if (ipdb(i).ne.0) then
                     it = ityp(ipdb(i)) 
                     if (it.ge.77.and.it.le.85) then
                        it = 76 - it
                        call setchg(ipdb(i),it)
                     endif
                  endif
               end do

               do i=1,mxhsym*3
                  if (ihpdb(i).ne.0) then
                     it = ityp(ihpdb(i)) 
                     if (it.ge.77.and.it.le.85) then
                        it = 76 - it
                        call setchg(ihpdb(i),it)
                     endif
                  endif
               end do

            endif
         endif
      endif

      return

100   continue

c     NUCLEOTIDES

      isrna = 1
      jtmp = irna(jres - 23)

      if (ipdb(53).eq.0.and.jres.ne.27) then
         isrna = 0
         jtmp = jtmp + 4
      endif

      do i=1,nnuc(jtmp)
         call settyp(ityp,ipdb(inuc(1,i,jtmp)),inuc(2,i,jtmp))
      end do

      do i=1,nhnuc(jtmp)
         call settyp(ityp,ihpdb(ihnuc(1,i,jtmp)),ihnuc(2,i,jtmp))
      end do

      if (ihpdb(115).ne.0) then
c        3'-Hydroxyl
         if (isrna.eq.1) then
            call settyp(ityp,ipdb(51),1237)
            call settyp(ityp,ihpdb(115),1238)
         else
            call settyp(ityp,ipdb(51),1249)
            call settyp(ityp,ihpdb(115),1250)
         endif
      endif

      if (ihpdb(118).ne.0) then
c        5'-Hydroxyl
         if (isrna.eq.1) then
            call settyp(ityp,ipdb(46),1232)
            call settyp(ityp,ihpdb(118),1233)
         else
            call settyp(ityp,ipdb(46),1244)
            call settyp(ityp,ihpdb(118),1245)
         endif
      endif

c     check P connected to O3* (ipdb(51)), if nconn O = 4 => 3'-Phosphate

      call chkpo4(ipdb(51),isrna,1239,1240,1241,1251,1252,1253,
     &                  ianz,iconn,ityp)

c     check P connected to O5* (ipdb(46)), if nconn O = 4 => 5'-Phosphate

      call chkpo4(ipdb(46),isrna,1234,1235,1236,1246,1247,1248,
     &                  ianz,iconn,ityp)

      do i=1,mxsym
         call setchg(ipdb(i),1)
      end do

      do i=1,mxhsym*3
         call setchg(ihpdb(i),1)
      end do

      return
      end

      subroutine chkpo4(io35,isrna,ir1,ir2,ir3,id1,id2,id3,
     &                  ianz,iconn,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      dimension icn(3),ianz(*),iconn(mxcon+1,*),ityp(*)

      ip = 0
      if (io35.eq.0) return

      do i=1,iconn(1,io35)
         j = iconn(1+i,io35)
         if (j.gt.0) then
            if (ianz(j).eq.15) ip = j
         endif
      end do

      if (ip.gt.0) then
         no = 0
         do i=1,iconn(1,ip)
            j = iconn(1+i,ip)

            if (j.gt.0) then
               if (ianz(j).eq.8.and.j.ne.io35) then
                  ido = 1

                  do k=1,iconn(1,j)
                     l = iconn(1+k,j)
                     if (l.gt.0) then
                        if (l.gt.1.and.l.ne.ip) ido = 0
                     endif
                  end do

                  if (ido.eq.1) then
                     no = no + 1
                     icn(no) = j
                  endif

               endif
            endif
         end do

         if (no.eq.3) then

            if (isrna.eq.1) then

c     R-3'-Phosphate: O3* 1239, P 1240 OP 1241

               call settyp(ityp,io35,ir1)
               call settyp(ityp,ip,ir2)
               call setchg(ip,1)

               do i=1,3
                  call settyp(ityp,icn(i),ir3)
                  call setchg(icn(i),1)
               end do

            else

c     D-3'-Phosphate: O3* 1251, P 1252 OP 1253

               call settyp(ityp,io35,id1)
               call settyp(ityp,ip,id2)
               call setchg(ip,1)

               do i=1,3
                  call settyp(ityp,icn(i),id3)
                  call setchg(icn(i),1)
               end do

            endif
         endif
      endif

      return
      end

      subroutine dotyd(ianz,iaton,iatclr,iconn,iresid,
     &                 lwrit,lring,ityp,coo,qat,icont,
     &                 icalf,ncalf,ianf,islu,nchain,iamino,ishoh)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)

      parameter (mxel=100)
      parameter (numatm=2000)
      parameter (mxcon=10)
      parameter (mxt=14)
      parameter (mxmol2=41)
      parameter (mxamb=1590)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxres=42)

      common /athlp/ iatoms, mxnat
      common /charge/ ihasq
      common /types/ iff
      character*5  mol2
      character*20 ambstr
      common /ftypes/ihasl(11),mol2(mxmol2),ambstr(mxamb)
      character*3 aminos
      common /amino/aminos(mxres)
      dimension ipdb(mxsym),ihpdb(mxhsym*3)
      dimension coo(3,*),ianz(*),iaton(*),iatclr(*),iconn(mxcon+1,*),
     &          iresid(*),ityp(*),lwrit(*),lring(*),qat(*),icont(*)
      dimension icalf(6,*),ianf(*),islu(*),iamino(*)

      natoms = iatoms

      if (ihasq.eq.1) idochg = 1

      do i=1,natoms
         lwrit(i) = 0
         lring(i) = 0
         icont(i) = iaton(i)
         iaton(i) = 2
         ityp(i) = 0
      end do


      iff = 3

c Tinker Amber

      do i=1,ncalf
         call getpdb(i,ipdb,ihpdb)
         call typamb(ipdb,iamino(i),ihpdb,1)
      end do

      if (ncalf.gt.0) then
          do i=1,nchain
c n-term cap
              call chkcap(ianf(i),1,iconn,ianz,iresid,qat,icalf,iamino)
c c-term cap
              call chkcap(islu(i),2,iconn,ianz,iresid,qat,icalf,iamino)
          end do
      endif

      do i=1,natoms

            if (iresid(i).le.-4) then
               if (iresid(i).eq.-ishoh) then
                  if (ianz(i).eq.8) ityp(i) = 649
                  if (ianz(i).eq.1) ityp(i) = 650
               else
                  ncnn = 0
                  do j=1,iconn(1,i)
                     if (iconn(1+j,i).gt.0) ncnn = ncnn + 1
                  end do

c metals
                  iset = 0
                  if (ianz(i).eq.3) then
                     ityp(i) = 651
                     qat(i) = 1.0d0
                     iset = 1
                  else if (ianz(i).eq.11) then
                     ityp(i) = 652
                     qat(i) = 1.0d0
                     iset = 1
                  else if (ianz(i).eq.19) then
                     ityp(i) = 653
                     qat(i) = 1.0d0
                     iset = 1
                  else if (ianz(i).eq.37) then
                     ityp(i) = 654
                     qat(i) = 1.0d0
                     iset = 1
                  else if (ianz(i).eq.55) then
                     ityp(i) = 655
                     qat(i) = 1.0d0
                     iset = 1
                  else if (ianz(i).eq.12) then
                     ityp(i) = 656
                     qat(i) = 2.0d0
                     iset = 1
                  else if (ianz(i).eq.20) then
                     ityp(i) = 657
                     qat(i) = 2.0d0
                     iset = 1
                  else if (ianz(i).eq.30) then
                     ityp(i) = 658
                     qat(i) = 2.0d0
                     iset = 1
                  else if (ianz(i).eq.17.and.ncnn.eq.0) then
                     ityp(i) = 659
                     qat(i) = -1.0d0
                     iset = 1
                  endif

               endif
            endif
      end do

      do i=1,iatoms
         iaton(i) = icont(i)
      end do

      return
      end

      subroutine calfd(istat,istpdb,iaddh,
     &                 ianz,iconn,ityp,
     &                 icalf,ncalf,ianf,islu,nchain,iamino,
     &                 isal,irsnr)

      implicit double precision (a-h,p-x),integer (i-n),logical (o)
      parameter (mxcon=10)
      common /athlp/ iatoms, mxnat
      parameter (mxsym=103)
      parameter (mxhsym=64)
      logical chkpdb
      common /surf/ natorg,noscnd
      logical cn,cco,ccb,cco1,chkhs
      common /types/ iff
      dimension ipdb(mxsym),ihpdb(mxhsym*3)
      dimension ianz(*),iconn(mxcon+1,*)
      dimension icalf(6,*),ianf(*),islu(*),iamino(*),isal(*),irsnr(*),
     &          ityp(*)

c icalf(1,*) is Calfa
c icalf(2,*) is N connected to Calfa
c icalf(3,*) is C=O connected to Calfa

      istat = 1

      call hcoord(iaddh)

      isold = 10000
      do i=1,ncalf
         if (iamino(i).gt.23) isal(i) = 2
         if (isal(i).ne.isold) then
             if (i.gt.1) then
                 if (lng.le.2) isal(i-1) = 3
             endif
             if (i.gt.2) then
                 if (lng.eq.2) isal(i-2) = 3
             endif
             lng = 1
         else
             lng = lng + 1
         endif
         isold = isal(i)
      end do
      
      if (iff.eq.0) then
         do i=1,nchain
            do j=ianf(i),islu(i)
               call getpdb(j,ipdb,ihpdb)
               if (.not.chkpdb(ipdb,iamino(j),j,irsnr,isal(j))) 
     &         then
                   print*,'incomplete residue: internal no. ',j
               endif
               if (iaddh.eq.1.and..not.chkhs(ihpdb)) then
                  if (j.eq.ianf(i)) then
                     call addhs(j,iamino(j),ipdb,ihpdb,1)
                  else
                     call addhs(j,iamino(j),ipdb,ihpdb,0)
                  endif
               endif
               call typeit(ipdb,iamino(j),ihpdb,1)
            end do
         end do
      else
         do i=1,nchain
            do j=ianf(i),islu(i)
               call getpdb(j,ipdb,ihpdb)
               if (.not.chkpdb(ipdb,iamino(j),j,irsnr,isal(j))) 
     &         then
                   print*,'incomplete residue: internal no.',j
               endif
            end do
         end do
      endif

      noscnd = iatoms

      return
      end

      subroutine addhd(ires,jres,ipdb,ihpdb,nterm,
     &                 ianz,iaton,iatclr,iresid,iconn,isurf,ipdbt,ityp,
     &                 ncalf,icalf,coo)
c
c Add hydrogens
c Only the Hydrogens attached to the backbone N are not covered
c This is done by routine hcoord
c
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxres=42)
      parameter (mxhs=15)
      parameter (mxyg=26)
      common /hcom/  iat(4,mxhs,mxres),nrs(mxres),rint(3,mxhs,mxres),
     &               iatyg(4,mxyg),rintyg(3,mxyg)
      common /athlp/ iatoms, mxnat
      logical addat, o5pcon
      real dih
      dimension ipdb(*), ihpdb(*), it(4), rt(4), icalf(6,*),isel(4)
      dimension ianz(*),iaton(*),iatclr(*),iconn(mxcon+1,*),itp(3),
     &          iresid(*),coo(3,*),ipdbt(*),ityp(*),isurf(*)
      data nrs /2,4,4,4,6,10,8,8,3,5,10,12,5,7,7,12,6,8,8,9,3*0,
     &          11,11,11,12,10,13,13,13,13,13,15,15,13,0,10,0,12,
     &          12,10/
c gly
      data ((iat(i,j,1),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 3,1,2,5, 52*0/  
      data ((rint(i,j,1),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.9779d0,107.66d0,-118.0d0, 
     &     39*0.0d0/  
c ala
      data ((iat(i,j,2),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 3,2,5,7, 3,2,5,8, 3,2,5,9,
     &     44*0/  
      data ((rint(i,j,2),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     33*0.0d0/  
c ser
      data ((iat(i,j,3),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 2,5,31,10, 31,2,5,7, 31,2,5,8,
     &     44*0/  
      data ((rint(i,j,3),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.867d0,107.06d0,180.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     33*0.0d0/  
c cys
      data ((iat(i,j,4),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 2,5,37,10, 37,2,5,7, 37,2,5,8,
     &     44*0/  
      data ((rint(i,j,4),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.867d0,107.06d0,180.0d0, 
     &     0.990d0,112.5d0,120.0d0, 0.990d0,112.5d0,-120.0d0,
     &     33*0.0d0/  
c thr
      data ((iat(i,j,5),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 32,8,5,7, 2,5,32,13, 
     &     2,5,8,16, 2,5,8,17, 2,5,8,18,
     &     36*0/  
      data ((rint(i,j,5),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.990d0,109.08d0,-120.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.978d0,110.0d0,180.0d0,
     &     0.978d0,110.0d0,60.0d0, 0.978d0,110.0d0,-60.0d0,
     &     27*0.0d0/  
c ile
      data ((iat(i,j,6),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 7,8,5,7,  7,5,8,16, 7,5,8,17, 7,5,8,18,
     &     10,5,7,13, 10,5,7,14, 5,7,10,22, 5,7,10,23, 5,7,10,24,
     &     20*0/  
      data ((rint(i,j,6),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.990d0,109.08d0,-120.0d0, 
     &     0.978d0,110.0d0,180.0d0,
     &     0.978d0,110.0d0,60.0d0, 0.978d0,110.0d0,-60.0d0,
     &     0.978d0,110.0d0,120.0d0, 0.978d0,110.0d0,-120.0d0,
     &     0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     15*0.0d0/  
c val
      data ((iat(i,j,7),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 7,8,5,7,  7,5,8,16, 7,5,8,17, 7,5,8,18,
     &     8,5,7,13, 8,5,7,14, 8,5,7,15,
     &     28*0/  
      data ((rint(i,j,7),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.990d0,109.08d0,120.0d0, 
     &     0.978d0,110.0d0,180.0d0,
     &     0.978d0,110.0d0,60.0d0, 0.978d0,110.0d0,-60.0d0,
     &     0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     21*0.0d0/  
c met
      data ((iat(i,j,8),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7,  6,2,5,8,
     &     36,5,6,10, 36,5,6,11, 
     &     6,36,12,28, 6,36,12,29, 6,36,12,30,
     &     28*0/  
      data ((rint(i,j,8),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 0.990d0,109.08d0,120.0d0, 
     &     0.990d0,109.08d0,-120.0d0,
     &     0.978d0,110.0d0,120.0d0, 0.978d0,110.0d0,-120.0d0,
     &     0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     21*0.0d0/  
c asp
      data ((iat(i,j,9),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8,
     &     48*0/  
      data ((rint(i,j,9),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     36*0.0d0/  
c asn
      data ((iat(i,j,10),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8,
     &     29,6,21,25, 29,6,21,26,
     &     40*0/  
      data ((rint(i,j,10),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.950d0,120.0d0,180.0d0, 0.950d0,120.0d0,0.0d0,
     &     30*0.0d0/  
c leu
      data ((iat(i,j,11),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8,
     &     5,10,6,10, 5,6,10,22, 5,6,10,23, 5,6,10,24,
     &     5,6,11,25, 5,6,11,26, 5,6,11,27,
     &     20*0/  
      data ((rint(i,j,11),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.9779d0,107.63d0,120.0d0,
     &     0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     15*0.0d0/  
c lys
      data ((iat(i,j,12),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 9,5,6,10, 9,5,6,11,
     &     12,6,9,19, 12,6,9,20, 27,9,12,28, 27,9,12,29,
     &     9,12,27,40, 9,12,27,41, 9,12,27,42,
     &     12*0/
      data ((rint(i,j,12),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,109.8d0,180.0d0, 
     &     0.990d0,109.8d0,60.0d0, 0.990d0,109.8d0,-60.0d0,
     &     9*0/
c glu
      data ((iat(i,j,13),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 9,5,6,10, 9,5,6,11,
     &     40*0/
      data ((rint(i,j,13),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     30*0/
c gln
      data ((iat(i,j,14),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 9,5,6,10, 9,5,6,11,
     &     34,9,24,34, 34,9,24,35,
     &     32*0/
      data ((rint(i,j,14),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.950d0,120.0d0,180.0d0, 0.950d0,120.0d0,0.0d0,
     &     24*0/
c pro
      data ((iat(i,j,15),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 9,5,6,10, 9,5,6,11,
     &     1,6,9,19, 1,6,9,20,
     &     32*0/
      data ((rint(i,j,15),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,109.4d0,-120.0d0, 0.990d0,109.4d0,120.0d0,
     &     0.990d0,109.4d0,-120.0d0, 0.990d0,109.4d0,120.0d0,
     &     0.990d0,109.4d0,-120.0d0, 0.990d0,109.4d0,120.0d0,
     &     24*0/
c arg
      data ((iat(i,j,16),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 9,5,6,10, 9,5,6,11,
     &     22,6,9,19, 22,6,9,20, 9,17,22,28,
     &     22,17,25,55, 22,17,25,56, 22,17,26,58, 22,17,26,59,
     &     12*0/
      data ((rint(i,j,16),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     0.990d0,112.5d0,-120.0d0, 0.990d0,112.5d0,120.0d0,
     &     1.020d0,120.0d0,180.0d0,
     &     1.020d0,120.0d0,0.0d0, 1.020d0,120.0d0,180.0d0,
     &     1.020d0,120.0d0,0.0d0, 1.020d0,120.0d0,180.0d0,
     &     9*0/
c his
      data ((iat(i,j,17),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 
     &     6,13,20,22, 20,24,13,31, 24,6,11,25,
     &     36*0/
      data ((rint(i,j,17),i=1,3),j=1,mxhs) /
     &     0.9779d0,107.63d0,118.0d0, 
     &     1.110d0,109.4d0,-120.0d0, 1.110d0,109.4d0,120.0d0,
     &     1.020d0,126.0d0,180.0d0, 1.100d0,126.0d0,180.0d0,
     &     1.020d0,126.0d0,180.0d0, 1.100d0,126.0d0,180.0d0,
     &     24*0/
c phe
      data ((iat(i,j,18),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 
     &     6,13,10,22, 10,17,13,31, 13,14,17,40, 17,11,14,34,
     &     14,6,11,25,
     &     28*0/
      data ((rint(i,j,18),i=1,3),j=1,mxhs) /
     &     1.110d0,107.9d0,118.0d0, 
     &     1.110d0,109.4d0,-120.0d0, 1.110d0,109.4d0,120.0d0,
     &     1.100d0,120.0d0,180.0d0, 1.100d0,120.0d0,180.0d0,
     &     1.100d0,120.0d0,180.0d0, 1.100d0,120.0d0,180.0d0,
     &     1.100d0,120.0d0,180.0d0,
     &     21*0/
c tyr
      data ((iat(i,j,19),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 
     &     6,13,10,22, 10,17,13,31, 13,17,33,52, 17,11,14,34,
     &     14,6,11,25,
     &     28*0/
      data ((rint(i,j,19),i=1,3),j=1,mxhs) /
     &     1.110d0,107.9d0,118.0d0, 
     &     1.110d0,109.4d0,-120.0d0, 1.110d0,109.4d0,120.0d0,
     &     1.100d0,120.0d0,180.0d0, 1.100d0,120.0d0,180.0d0,
     &     0.970d0,108.0d0,0.0d0, 1.100d0,120.0d0,180.0d0,
     &     1.100d0,120.0d0,180.0d0,
     &     21*0/
c trp
      data ((iat(i,j,20),i=1,4),j=1,mxhs) /
     &     3,1,2,4, 6,2,5,7, 6,2,5,8, 
     &     6,23,10,22, 10,14,23,31, 14,16,18,46, 18,19,16,58,
     &     16,15,19,49, 11,19,15,37,
     &     24*0/
      data ((rint(i,j,20),i=1,3),j=1,mxhs) /
     &     1.110d0,107.9d0,118.0d0, 
     &     1.110d0,109.4d0,-120.0d0, 1.110d0,109.4d0,120.0d0,
     &     1.100d0,124.0d0,180.0d0, 1.050d0,124.0d0,180.0d0,
     &     1.100d0,120.0d0,180.0d0, 1.100d0,120.0d0,180.0d0,
     &     1.100d0,120.0d0,180.0d0, 1.100d0,120.0d0,180.0d0,
     &     18*0/

c asx,glx,hyp not yet

      data (((iat(i,j,k),i=1,4),j=1,mxhs),k=21,23) /180*0/
      data (((rint(i,j,k),i=1,3),j=1,mxhs),k=21,23) /135*0.0d0/

c adenosine

      data ((iat(i,j,24),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,62,60,55,82, 60,58,64,-136, 60,58,64,-137,
     &     16*0/
      data ((rint(i,j,24),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 1.080d0,116.0d0,180.0d0,
     &     1.010d0,120.0d0,180.0d0, 1.010d0,120.0d0,0.0d0,
     &     12*0/

c cytidine

      data ((iat(i,j,25),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103,58,56,57,100, 57,56,63,-130, 57,56,63,-131,
     &     16*0/
      data ((rint(i,j,25),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,118.0d0,180.0d0, 1.080d0,123.4d0,180.0d0,
     &     1.010d0,120.0d0,180.0d0, 1.010d0,120.0d0,0.0d0,
     &     12*0/

c guanosine

      data ((iat(i,j,26),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,58,55,60,-121, 60,55,61,-124, 60,55,61,-125,
     &     16*0/
      data ((rint(i,j,26),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 1.008d0,118.5d0,180.0d0,
     &     1.009d0,120.0d0,180.0d0, 1.009d0,120.0d0,0.0d0,
     &     12*0/

c thimidine

      data ((iat(i,j,27),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103, 56,55,62,-127, 
     &     56,57,83,160, 56,57,83,161, 56,57,83,162,
     &     12*0/
      data ((rint(i,j,27),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,118.0d0,180.0d0, 1.010d0,117.0d0,180.0d0, 
     &     1.090d0,109.8d0,180.0d0,1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     9*0/

c uridine

      data ((iat(i,j,28),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103,58,56,57,100, 56,55,62,-127, 
     &     20*0/
      data ((rint(i,j,28),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,118.0d0,180.0d0, 1.080d0,119.4d0,180.0d0,
     &     1.010d0,117.0d0,180.0d0, 
     &     15*0/

c 1MA

      data ((iat(i,j,29),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,62,60,55,82, 
     &     60,58,64,-137, 58,60,79,148, 58,60,79,149, 58,60,79,150, 
     &     0,0,0,0, 0,0,0,0/
      data ((rint(i,j,29),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0, 
     &     1.080d0,120.0d0,180.0d0,1.080d0,120.0d0,180.0d0,
     &     1.010d0,120.0d0,180.0d0,
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     1.080d0,90.0d0,90.0d0,0.0d0,.0d0,0.0d0/

c 5MC

      data ((iat(i,j,30),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103, 57,56,63,-130, 57,56,63,-131, 
     &     56,57,83,160, 56,57,83,161, 56,57,83,162,
     &     8*0/
      data ((rint(i,j,30),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0, 1.080d0,118.0d0,180.0d0,
     &     1.010d0,120.0d0,180.0d0, 1.010d0,120.0d0,0.0d0,
     &     1.090d0,109.8d0,180.0d0,1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     6*0/

c OMC

      data ((iat(i,j,31),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 
     &     52,53,80,151, 52,53,80,152, 52,53,80,153,
     &     60,57,58,103,58,56,57,100, 57,56,63,-130, 57,56,63,-131,
     &     8*0/
      data ((rint(i,j,31),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     1.080d0,118.0d0,180.0d0, 1.080d0,123.4d0,180.0d0,
     &     1.010d0,120.0d0,180.0d0, 1.010d0,120.0d0,0.0d0,
     &     6*0/

c 1MG

      data ((iat(i,j,32),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,
     &     58,60,79,148, 58,60,79,149, 58,60,79,150,
     &     60,55,61,-124, 60,55,61,-125,
     &     8*0/
      data ((rint(i,j,32),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0, 1.080d0,122.0d0,180.0d0, 
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     1.009d0,120.0d0,180.0d0, 1.009d0,120.0d0,0.0d0,
     &     6*0/

c 2MG

      data ((iat(i,j,33),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,58,55,60,-121, 60,55,61,-124, 
     &     55,61,80,151, 55,61,80,152, 55,61,80,153,
     &     8*0/
      data ((rint(i,j,33),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 1.008d0,118.5d0,180.0d0,
     &     1.009d0,120.0d0,0.0d0, 
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     6*0/

c M2G

      data ((iat(i,j,34),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,58,55,60,-121, 
     &     55,61,79,148, 55,61,79,149, 55,61,79,150,
     &     55,61,80,151, 55,61,80,152, 55,61,80,153/
      data ((rint(i,j,34),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 1.008d0,118.5d0,180.0d0,
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0/

c 7MG

      data ((iat(i,j,35),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,58,55,60,-121, 60,55,61,-124, 
     &     60,55,61,-125,57,65,85,166, 57,65,85,167, 57,65,85,168,
     &     0,0,0,0/
      data ((rint(i,j,35),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 
     &     1.008d0,118.5d0,180.0d0,
     &     1.009d0,120.0d0,180.0d0, 1.009d0,120.0d0,0.0d0,
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,0.0d0,0.0d0,0.0d0/

c OMG

      data ((iat(i,j,36),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 
     &     52,53,80,151, 52,53,80,152, 52,53,80,153,
     &     66,65,59,112,58,55,60,-121, 60,55,61,-124, 60,55,61,-125,
     &     8*0/
      data ((rint(i,j,36),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,180.0d0, 1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     1.080d0,122.0d0,180.0d0, 1.008d0,118.5d0,180.0d0,
     &     1.009d0,120.0d0,180.0d0, 1.009d0,120.0d0,0.0d0,
     &     6*0/

c NO YG

      data ((iat(i,j,37),i=1,4),j=1,mxhs) /60*0/
      data ((rint(i,j,37),i=1,3),j=1,mxhs) /45*0.0d0/

c inosine

      data ((iat(i,j,38),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,58,55,60,-121,62,60,55,82, 
     &     20*0/
      data ((rint(i,j,38),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 1.008d0,118.5d0,180.0d0,
     &     1.080d0,122.0d0,180.0d0,
     &     15*0/

c NO +U

      data ((iat(i,j,39),i=1,4),j=1,mxhs) /60*0/
      data ((rint(i,j,39),i=1,3),j=1,mxhs) /45*0.0d0/

c H2U

      data ((iat(i,j,40),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103,60,57,58,104,58,56,57,100,58,56,57,101,
     &     56,55,62,-127, 
     &     12*0/
      data ((rint(i,j,40),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,118.0d0,120.0d0, 1.080d0,119.4d0,-120.0d0,
     &     1.080d0,118.0d0,120.0d0, 1.080d0,119.4d0,-120.0d0,
     &     1.010d0,117.0d0,180.0d0, 
     &     9*0/

c 5MU

      data ((iat(i,j,41),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103,56,55,62,-127, 
     &     56,57,83,160, 56,57,83,161, 56,57,83,162,
     &     12*0/
      data ((rint(i,j,41),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,118.0d0,180.0d0, 1.010d0,117.0d0,180.0d0, 
     &     1.090d0,109.8d0,180.0d0,1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     9*0/


c PSU

      data ((iat(i,j,42),i=1,4),j=1,mxhs) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     60,57,58,103,55,58,60,-121, 56,55,62,-127, 
     &     20*0/
      data ((rint(i,j,42),i=1,3),j=1,mxhs) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,118.0d0,180.0d0, 1.010d0,117.0d0,180.0d0,
     &     1.010d0,117.0d0,180.0d0, 
     &     15*0/

c YG

      data ((iatyg(i,j),i=1,4),j=1,mxyg) /
     &     46,48,47,61, 46,48,47,62, 47,49,48,64,
     &     48,52,50,67, 50,54,52,70, 52,49,54,73, 50,52,53,76,
     &     66,65,59,112,56,62,88,91, 56,62,88,92, 56,62,88,93,
     &     61,90,89,175, 61,90,89,176, 61,90,89,177,
     &     91,93,92,178, 91,93,92,179,
     &     92,94,93,181, 92,94,93,182, 93,95,94,184,
     &     95,97,98,187, 95,97,98,188, 95,97,98,189,
     &     94,100,99,-124,
     &     100,102,103,190, 100,102,103,191, 100,102,103,192/
      data ((rintyg(i,j),i=1,3),j=1,mxyg) /
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,-120.0d0, 1.090d0,109.8d0,120.0d0,
     &     0.957d0,108.4d0,49.8d0,
     &     1.080d0,122.0d0,180.0d0, 1.090d0,109.8d0,180.0d0,
     &     1.090d0,109.8d0,60.0d0, 1.090d0,109.8d0,-60.0d0,
     &     1.090d0,109.8d0,180.0d0,1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,120.0d0, 1.090d0,109.8d0,-120.0d0,
     &     1.090d0,109.8d0,120.0d0,
     &     1.090d0,109.8d0,180.0d0,1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0, 1.010d0,120.0d0,180.0d0,
     &     1.090d0,109.8d0,180.0d0,1.090d0,109.8d0,60.0d0,
     &     1.090d0,109.8d0,-60.0d0/

c
c for nucleotides the H's that make hydrogen bonds are added
c by subroutine mkcon, addhy1 and addhy2, these atoms are flagged
c via array isurf, which is used by dohcon to create hydrogen bonds
c this routine does not do that
c
c OXT = O3P , do we have to add H's to O2P,O3P, at present NO
c

      if (jres.le.0.or.jres.gt.mxres) return

      if (jres.eq.37) then
         nh = mxyg
      else
         nh = nrs(jres)
      endif

      do i=1,nh

          if (jres.eq.37) then
              do j=1,4
                 it(j) = iatyg(j,i)
              end do
              do j=1,3
                 rt(j) = rintyg(j,i)
              end do
          else
              do j=1,4
                 it(j) = iat(j,i,jres)
              end do
              do j=1,3
                 rt(j) = rint(j,i,jres)
              end do
          endif

          ih = abs(it(4))
          itp(1) = ipdb(it(1))
          itp(2) = ipdb(it(2))
          itp(3) = ipdb(it(3))
          ihp = ihpdb(ih)

          if (jres.eq.4.and.i.eq.2) then
              if (ipdb(37).gt.0.and.ipdb(37).lt.mxnat) then
                 if (iconn(1,ipdb(37)).gt.1) ihp = 1
              endif
          endif
          if (jres.eq.3.and.i.eq.2) then
              if (ipdb(31).gt.0.and.ipdb(31).lt.mxnat) then
                 if (iconn(1,ipdb(31)).gt.1) ihp = 1
              endif
          endif
          if (jres.eq.10.and.i.ge.4) then
              if (ipdb(21).gt.0.and.ipdb(21).lt.mxnat) then
                 if ((iconn(1,ipdb(21)).gt.1.and.i.eq.4).or.
     &               (iconn(1,ipdb(21)).gt.2.and.i.eq.5)) then
                     if (i.eq.4) then
                        rt(2) = 120.0d0
                        rt(3) = 180.0d0
                     elseif (i.eq.5) then
                        ihp = 1
                     endif
                 endif
              endif
          endif
          if (jres.eq.12.and.i.ge.10) then
              n = 0
              if (ipdb(27).gt.0.and.ipdb(27).lt.mxnat.and.i.eq.10) then
                  if (iconn(1,ipdb(27)).eq.2) ihp = 1
              endif
              if (ipdb(27).gt.0.and.ipdb(27).lt.mxnat) then
                 n = iconn(1,ipdb(27)) - 1
              endif
              if (n.gt.2) ihp = 1
          endif
          if (jres.eq.17.and.i.eq.4) then
              if (ipdb(20).gt.0) then
                 if (iconn(1,ipdb(20)).gt.2) ihp = 1
              endif
          endif
          if (ihp.eq.0) then
              if (addat(itp(1),itp(2),
     &            itp(3),1,rt(1),rt(2),rt(3),ihpdb(ih),1,
     &            ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &            ncalf,icalf,coo)) then
                  iresid(ihpdb(ih)) = ires
                  ipdbt(ihpdb(ih)) = ih
                  if (it(4).lt.0) isurf(ihpdb(ih)) = 1
              endif
          endif
      end do

      if (jres.gt.23) then
c
c deal with DNA as well
c
         if (ipdb(53).eq.0) then
             if (addat(ipdb(50),ipdb(54),ipdb(52),1,
     &        1.090d0,109.8d0,120.0d0,ihpdb(71),1,
     &            ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &            ncalf,icalf,coo)) then
                 iresid(ihpdb(71)) = ires
                 ipdbt(ihpdb(71)) = 71
             endif
         endif

c HO3

         if (ipdb(51).ne.0) then
             n = icred(ipdb(51),inoh,ih,ianz,iconn)
             if (inoh.eq.1.and.ih.eq.0) then
                if (addat(ipdb(52),ipdb(50),ipdb(51),1,
     &           0.960d0,109.8d0,120.0d0,ihpdb(115),1,
     &            ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &            ncalf,icalf,coo)) then
                    iresid(ihpdb(115)) = ires
                    ipdbt(ihpdb(115)) = 115
                endif
             endif
         endif

         if (ipdb(43).eq.0.and.ipdb(46).ne.0) then
             if (.not.o5pcon(ipdb(46),ianz,iconn)) then
                if (addat(ipdb(48),ipdb(47),ipdb(46),1,
     &           0.960d0,109.8d0,120.0d0,ihpdb(118),1,
     &            ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &            ncalf,icalf,coo)) then
                    iresid(ihpdb(118)) = ires
                    ipdbt(ihpdb(118)) = 118
                    icalf(1,ires) = ihpdb(118)
                endif
             endif
         endif

      else

         if (nterm.eq.1) then
            n = icred(ipdb(1),inoh,ih,ianz,iconn)
            if (inoh.eq.1.and.ih.eq.1.and.ihpdb(1).ne.0) then
               if (addat(ihpdb(1),ipdb(2),ipdb(1),1,
     &          1.010d0,109.8d0,120.0d0,ihpdb(2),1,
     &            ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &            ncalf,icalf,coo)) then
                   iresid(ihpdb(2)) = ires
                   ipdbt(ihpdb(2)) = 2
               endif
               if (addat(ihpdb(1),ipdb(2),ipdb(1),1,
     &          1.010d0,109.8d0,-120.0d0,ihpdb(3),1,
     &            ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &            ncalf,icalf,coo)) then
                   iresid(ihpdb(3)) = ires
                   ipdbt(ihpdb(3)) = 3
               endif
            endif
         endif

      endif

      return
      end

      logical function addat(iat1,iat2,iat3,ian,bl,alpha,dih,iret,ichk,
     &                       ianz,iaton,iatclr,iconn,iresid,ityp,ipdbt,
     &                       ncalf,icalf,coo)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      common /athlp/ iatoms, mxnat
      dimension v21(3),v32(3),c1(3),c2(3),c3(3),c4(3),ctmp(3)
      dimension coo(3,*),ianz(*),iaton(*),iatclr(*),iresid(*),
     &          iconn(mxcon+1,*),ityp(*),ipdbt(*),icalf(6,*)

c
c     Add atom given bondlength, bondangle and dihedral with
c     respect to three atoms
c
      iret = 0
      addat = .true.
      
      if (iat1.le.0.or.iat1.gt.mxnat) goto 100
      if (iat2.le.0.or.iat2.gt.mxnat) goto 100
      if (iat3.le.0.or.iat3.gt.mxnat) goto 100

      tol = 1.0d-10
      toang = 0.52917706d0
      todeg = 45.0d0 / datan(1.0d0)
      sa = dsin(alpha/todeg)
      ca = dcos(alpha/todeg)
      sd = dsin(dih/todeg)
      cd = dcos(dih/todeg)

      do i=1,3
          v21(i) = coo(i,iat2) - coo(i,iat1)
          v32(i) = coo(i,iat3) - coo(i,iat2)
      end do
      call vsc1(v32,1.0d0,tol)

c     check for three atoms on a line

      call impsc(v21,v32,cosb)
      if (dabs(cosb).lt.tol) goto 100

      call crprod(v21,v32,c1)
      call vsc1(c1,1.0d0,tol)
      call crprod(c1,v32,c2)
      call vsc1(c2,1.0d0,tol)

      do i=1,3
          c3(i) = cd*c2(i) + sd*c1(i)
      end do
      
      do i=1,3
          c4(i) = -ca*v32(i) + sa*c3(i)
      end do

      call vsc1(c4,bl/toang,tol)

      if (iatoms.ge.mxnat) goto 100

      do i=1,3
         ctmp(i) = coo(i,iat3) + c4(i)
      end do

      iflg = 0
      do i=1,iatoms
          d2 = dist2(ctmp,coo(1,i))
          if (d2*toang*toang.lt.0.7d0) then
             iflg = 1
             d2t = d2
             i2t = i
          endif
      end do

      if (iflg.eq.1.and.ichk.eq.1) goto 100

      natoms = 0
      if (iresid(iat3).lt.-3) then
         do i=1,iatoms
            if (iresid(i).eq.iresid(iat3)) then
               natoms = i + 1
            endif
         end do
      endif

      if (natoms.eq.0) then
          natoms = iatoms + 1
      else


         do i=1,natoms-1
            do j=1,iconn(1,i)
               it = iconn(1+j,i)
               iat = iabs(it)
               if (it.ge.0) then
                  if (it.ge.natoms) then
                     iconn(1+j,i) = it + 1
                  endif
               else
                  if (iat.ge.natoms) then
                     iconn(1+j,i) = it - 1
                  else
                     iconn(1+j,i) = it
                  endif
               endif
            end do
         end do

         do i=iatoms,natoms,-1
            iconn(1,i+1) = iconn(1,i)
            do j=1,iconn(1,i)
               it = iconn(1+j,i)
               iat = iabs(it)
               if (it.ge.0) then
                  if (it.ge.natoms) then
                     iconn(1+j,i+1) = it + 1
                  else
                     iconn(1+j,i+1) = it
                  endif
               else
                  if (iat.ge.natoms) then
                     iconn(1+j,i+1) = it - 1
                  else
                     iconn(1+j,i+1) = it
                  endif
               endif
            end do

            ianz(i+1)    = ianz(i)
            iaton(i+1)   = iaton(i)
            iatclr(i+1)  = iatclr(i)
            iresid(i+1)  = iresid(i)
            ityp(i+1)    = ityp(i)
            ipdbt(i+1)   = ipdbt(i)

            do j=1,3
               coo(j,i+1) = coo(j,i)
            end do

         end do

         do i=1,ncalf
            if (icalf(1,i).ge.natoms) icalf(1,i) = icalf(1,i) + 1
            if (icalf(4,i).ge.natoms) icalf(4,i) = icalf(4,i) + 1
         end do

      endif

      iatoms = iatoms + 1
      iret = natoms

      do i=1,3
         coo(i,natoms) = coo(i,iat3) + c4(i)
      end do

      iconn(1,natoms) = 1
      iconn(2,natoms) = iat3
      ianz(natoms)    = ian
      iaton(natoms)   = 1
      iatclr(natoms)  = iatclr(iat3)
      iresid(natoms)  = iresid(iat3)
      ityp(natoms)    = 0
      ipdbt(natoms)   = 0

      if (iconn(1,iat3).lt.mxcon) then
         iconn(1,iat3) = iconn(1,iat3) + 1
         iconn(iconn(1,iat3)+1,iat3) = natoms
      endif

      return

100   addat = .false.
      return
      end

      subroutine vsc1(a,scale,tol)
      implicit double precision (a-h,o-z)
      dimension a(3)

      rlen = vlen(a)

      if (rlen.gt.tol) then
         do i=1,3
            a(i) = a(i)*scale/rlen
         end do
      endif

      return
      end

      subroutine impsc(a,b,c)
      implicit double precision (a-h,o-z)
      dimension a(3),b(3)

      rimp = 0.0d0
    
      do i=1,3
         rimp = rimp + a(i)*b(i)
      end do

      al = vlen(a)
      bl = vlen(b)

      if (al.gt.0.0d0.and.bl.gt.0.0d0) then
         c = rimp/(vlen(a)*vlen(b))
      else
         c = 0.0d0
      endif

      return
      end

      double precision function dist2(a,b)
c
c     determine distances between neighboring atoms
c
      implicit double precision (a-h,o-z)
      dimension a(3)
      dimension b(3)

      d1 = a(1)-b(1)
      d2 = a(2)-b(2)
      d3 = a(3)-b(3)

      dist2 = d1*d1 + d2*d2 + d3*d3

      return
      end

      logical function o5pcon(iat,ianz,iconn)
      parameter (mxcon=10)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      dimension ianz(*),iconn(mxcon+1,*)
   
      o5pcon = .false.

      do i=1,iconn(1,iat)
         ii = iconn(1+i,iat)
         if (ii.gt.0) then
            if (ianz(ii).eq.15) o5pcon = .true.
         endif
      end do
      
      return
      end

      subroutine hcoodd(istat,iaddh,
     &                  ipdbt,coo,ianz,iaton,iresid,iconn,
     &                  icalf,ncalf,ianf,islu,nchain,iamino)
      implicit double precision (a-h,p-x),integer (i-n),logical (o)
      parameter (mxcon=10)
      common /athlp/ iatoms, mxnat
      parameter (numcal=50000)
      common /hbonds/ hbd(2,numcal),ihb(2,numcal)
      logical hashy
      dimension tmp(3),ipdbt(*)
      dimension coo(3,*),ianz(*),iaton(*),iresid(*),iconn(mxcon+1,*)
      dimension icalf(6,*),ianf(*),islu(*),iamino(*)

      istat = 1

c     nhbond in A.U. Atomic Units

      if (iatoms+ncalf.le.mxnat.and.ncalf.gt.0) then

         nhatm = iatoms

         do k=1,nchain
c
c           first residue
c
	  ianfk = ianf(k)
          if (icalf(2,ianf(k)).eq.0) ianfk = ianfk+1

          if (iamino(ianfk).le.23.and.ianfk.ge.0.and.
     &        ianfk.gt.0) then

            hashy = .false.
            if (iaddh.eq.1) hashy = .true.

            do n=1,iconn(1,icalf(2,ianfk))
               nn = abs(iconn(n+1,icalf(2,ianfk)))
               if (ianz(nn).eq.1) then
                  hashy = .true.
                  icalf(4,ianf(k)) = nn
                  iaton(nn) = 0
                  iresid(nn) = ianf(k)
               endif
            end do

            if (.not.hashy.and.iamino(ianfk).ne.15.and.
     &         iamino(ianfk).ne.0) then
               call bckok(ibckok,ianfk,2)
               if (ibckok.eq.1) then
                  icor = 0
                  do j=1,iconn(1,icalf(2,ianfk))
                     jc = iconn(1+j,icalf(2,ianfk))
                     jc = iabs(jc)
                     if (iresid(jc).lt.-3) then
                        if (ianz(jc).eq.6) then
                           do jj=1,iconn(1,jc)
                              jo = iconn(1+jj,jc)
                              jo = iabs(jo)
                              if (ianz(jo).eq.8) then
                                icor = jo
                              endif
                           end do
                        endif
                     endif
                  end do
                  nhatm = nhatm + 1
                  icalf(4,ianfk) = nhatm

                  if (icor.ne.0) then
                     do j=1,3
                        tmp(j) = 2.0d0*coo(j,icalf(2,ianf(k))) 
     &                         - coo(j,icalf(1,ianf(k)))
     &                         - coo(j,icor)
                     end do

                     tmpl = vlen(tmp)

                     do j=1,3
                        coo(j,nhatm) = coo(j,icalf(2,ianf(k))) 
     &                                 +(tmp(j)/tmpl)*1.89d0
                     end do
                  else

                     do j=1,3
                        tmp(j) = coo(j,icalf(1,ianf(k))) 
     &                         - coo(j,icalf(3,ianf(k)))
                     end do

                     tmpl = vlen(tmp)

                     if (icalf(2,ianf(k)).gt.0) then
                        do j=1,3
                           coo(j,nhatm) = coo(j,icalf(2,ianf(k))) 
     &                                    +(tmp(j)/tmpl)*1.89d0
                        end do
                     endif

                  endif

                  iaton(nhatm) = 0
                  ianz(nhatm) = 1
                  iconn(1,nhatm) = 1

                  m = icalf(2,ianf(k))
                  if (m.ne.-1) then
                     iconn(2,nhatm) = m
                     iconn(1,m) = iconn(1,m) + 1
                     iconn(1+iconn(1,m),m) = nhatm
                  endif

                  iresid(nhatm) = ianf(k)
                  ipdbt(nhatm) = 1
               endif
            endif
            ihb(1,ianfk) = 0
            ihb(2,ianfk) = 0
           endif
c
c           other residues
c
           if (ianfk.ge.0) then

            do i=ianfk+1,islu(k)
             if (iamino(i).le.23) then
               icalf(4,i) = 0
               hashy = .false.
               do n=1,iconn(1,icalf(2,i))
                  nn = abs(iconn(n+1,icalf(2,i)))
                  if (ianz(nn).eq.1) then
                     hashy = .true.
                     icalf(4,i) = nn
                     iaton(nn) = 0
                     iresid(nn) = i
                  endif
               end do

               if (.not.hashy.and.iamino(i).ne.15) then

                  m = icalf(2,i)
                  idxc = icalf(3,i-1)
                  idxo = 0

                  do j=1,iconn(1,idxc)
                     kk = abs(iconn(j+1,idxc))
                     if (ianz(kk).eq.8) idxo = kk
                  end do

                  call bckok(ibckok,i,2)

                  if (idxo.ne.0.and.ibckok.eq.1) then

                     nhatm = nhatm + 1
                     icalf(4,i) = nhatm

                     do j=1,3
                        tmp(j) = coo(j,idxc) - coo(j,idxo)
                     end do

                     tmpl = vlen(tmp)

                     do j=1,3
                        coo(j,nhatm) = coo(j,m) +
     &                             (tmp(j) / tmpl)*1.89d0
                     end do

                     iaton(nhatm) = 0
                     ianz(nhatm) = 1
                     iconn(1,nhatm) = 1
                     iconn(2,nhatm) = m
                     iconn(1,m) = iconn(1,m) + 1
                     iconn(1+iconn(1,m),m) = nhatm
                     iresid(nhatm) = i
                     ipdbt(nhatm) = 1
                  else
                     icalf(4,i) = 0
                  endif

               endif

               ihb(1,i) = 0
               ihb(2,i) = 0
              endif
            end do
           endif
         end do
         iatoms = nhatm
      else

         istat = 0
         do i=1,ncalf
            if (iamino(i).le.23) icalf(4,i) = 0
         end do

      endif

      return
      end

      subroutine bckod(ibckok,ires,iop,
     &                  ianz,iresid,ipdbt,iamino)
      implicit double precision (a-h,o-z)

      parameter (mxsym=103)
      common /athlp/ iatoms, mxnat
      dimension ipdb(mxsym)
      dimension ianz(*),iresid(*),ipdbt(*),iamino(*)

c checks if Calpha is present (iop=1)

      ibckok = 0

      do i=1,mxsym
          ipdb(i) = 0
      end do

      do i=1,iatoms
          if (iresid(i).eq.ires) then
              if (ipdbt(i).ne.0) then
                  if (ianz(i).ne.1) then
                     ipdb(ipdbt(i)) = i
                  endif
              endif
          endif
      end do

c has Calpha
      if (iamino(ires).gt.23) then
         if (iop.eq.1.and.(ipdb(43).ne.0.or.ipdb(46).ne.0)) 
     &       ibckok = 1
      else
         if (iop.eq.1.and.ipdb(2).ne.0) ibckok = 1
         if (iop.eq.2.and.
     &      (ipdb(1).ne.0.and.ipdb(2).ne.0.and.ipdb(3).ne.0)
     &      ) ibckok = 1
      endif

      return
      end

      logical function chkpdb(ipdb,jres,icres,irsnr,isal)
      implicit double precision (a-h,o-z)
      parameter (mxres=42)
      parameter (mxares=20)
      parameter (mxaat=13)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxamb=1590)
      parameter (mxgff=72)
      parameter (mxamo=201)
      character*3 aminos
      common /amino/aminos(mxres)
      integer resn,resat
      common /resa/ resat(mxares,mxaat),resn(mxares)
      character*3 pdbsym,hsym,chtnk,ambtnk
      character*2 amotnk,gffstr
      common /symbol/ pdbsym(mxsym),hsym(mxhsym),
     &                ambtnk(mxamb),gffstr(mxgff)
      parameter (mxinrs=100)
      common /incmpl/ incomp(mxinrs),nincmp
      dimension ipdb(*),irsnr(*)

      data resn/4,4,6,6,7,8,7,8,8,8,8,9,9,9,8,11,10,11,12,13/
c glycine
      data (resat(1,i),i=1,mxaat)/
     &          1,2,3,4,0,0,0,0,0,0,0,0,0/
c alanine
      data (resat(2,i),i=1,mxaat)/
     &          1,2,3,4,0,0,0,0,0,0,0,0,0/
c serine
      data (resat(3,i),i=1,mxaat)/
     &          1,2,3,4,5,31,0,0,0,0,0,0,0/
c cysteine
      data (resat(4,i),i=1,mxaat)/
     &          1,2,3,4,5,37,0,0,0,0,0,0,0/
c threonine
      data (resat(5,i),i=1,mxaat)/
     &          1,2,3,4,5,32,8,0,0,0,0,0,0/
c isoleucine
      data (resat(6,i),i=1,mxaat)/
     &          1,2,3,4,5,7,8,10,0,0,0,0,0/
c valine
      data (resat(7,i),i=1,mxaat)/
     &          1,2,3,4,5,7,8,0,0,0,0,0,0/
c methionine
      data (resat(8,i),i=1,mxaat)/
     &          1,2,3,4,5,6,36,12,0,0,0,0,0/
c aspartic acid
      data (resat(9,i),i=1,mxaat)/
     &          1,2,3,4,5,6,29,30,0,0,0,0,0/
c asparagine
      data (resat(10,i),i=1,mxaat)/
     &          1,2,3,4,5,6,29,21,0,0,0,0,0/
c leucine
      data (resat(11,i),i=1,mxaat)/
     &          1,2,3,4,5,6,10,11,0,0,0,0,0/
c lysine
      data (resat(12,i),i=1,mxaat)/
     &          1,2,3,4,5,6,9,12,27,0,0,0,0/
c glutamic acid
      data (resat(13,i),i=1,mxaat)/
     &          1,2,3,4,5,6,9,34,35,0,0,0,0/
c glutamine
      data (resat(14,i),i=1,mxaat)/
     &          1,2,3,4,5,6,9,24,34,0,0,0,0/
c proline 28 ?
      data (resat(15,i),i=1,mxaat)/
     &          1,2,3,4,5,6,9,1,0,0,0,0,0/
c arginine
      data (resat(16,i),i=1,mxaat)/
     &          1,2,3,4,5,6,9,17,22,25,26,0,0/
c histidine 
      data (resat(17,i),i=1,mxaat)/
     &          1,2,3,4,5,6,11,13,20,24,0,0,0/
c phenylalanine
      data (resat(18,i),i=1,mxaat)/
     &          1,2,3,4,5,6,10,11,13,14,17,0,0/
c tyrosine
      data (resat(19,i),i=1,mxaat)/
     &          1,2,3,4,5,6,10,11,13,14,17,33,0/
c tryptophan
      data (resat(20,i),i=1,mxaat)/
     &          1,2,3,4,5,6,10,11,14,15,16,18,23/

      iresa = -1
      if (jres.le.20) then
         do i=1,resn(jres)
            if (ipdb(2).le.0) isal = 4
            if (ipdb(resat(jres,i)).le.0) then
               chkpdb = .false.
               print*,'incomplete residue ',irsnr(icres),' ',
     &                 aminos(jres),' ',pdbsym(resat(jres,i))
               nincmp = nincmp + 1
               incomp(nincmp) = icres
               return
            endif
         end do
      endif

      chkpdb = .true.
      return
      end
          
      logical function chkhs(ihpdb)
      implicit double precision (a-h,o-z)
      parameter (mxhsym=64)
      dimension ihpdb(*)

      chkhs = .false.
      do i=2,mxhsym*3
         if (ihpdb(i).ne.0) chkhs = .true.
      end do

      return
      end

      subroutine typeid(ipdb,jres,ihpdb,ihashy,
     &                  ianz,iconn,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxrss=20)
      parameter (mxatt=10)
      parameter (mxath=8)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      logical nterm
      common /types/ iff
      common /chmtyp/ ncc(mxrss),icc(2,mxatt,mxrss),
     &                nhh(mxrss),ihh(2,mxath,mxrss)
      dimension ipdb(*), ihpdb(*),ianz(*),iconn(mxcon+1,*),ityp(*)

      iff = 2

c     currently only works for aminoacids, not nucleic acids 
c     (mxrss=20)

c     Backbone, no N-Term, C-Term yet
c               (Pro,Gly N-Term) CYS, sulfur bridged

      do i=1,mxsym
         call settyp(ityp,ipdb(i),0)
      end do
      do i=1,mxhsym*3
         call settyp(ityp,ihpdb(i),0)
      end do

      if (jres.le.0.or.jres.gt.mxrss) return

      if (jres.eq.17) then
c ihis
c 
c  1  HIS+ (HIP)
c  2  HISD (HID)
c  3  HISE (HIE)
c
         ihis = 1
         if (ihashy.eq.1) then
            if (ihpdb(34).eq.0) ihis = 2
            if (ihpdb(22).eq.0) ihis = 3
         endif
      endif

      call settyp(ityp,ipdb(1),63)
      call settyp(ityp,ipdb(2),23)
      call settyp(ityp,ipdb(3),20)
      call settyp(ityp,ipdb(4),74)

      if (ipdb(38).ne.0) then
          ityp(ipdb(38)) = 79
          call settyp(ityp,ipdb(4),79)
          call settyp(ityp,ipdb(3),22)
      endif

      do i=1,ncc(jres)
         call settyp(ityp,ipdb(icc(1,i,jres)),icc(2,i,jres))
      end do

      if (jres.eq.4) then
         do i=1,iconn(1,ipdb(37))
            if (ianz(abs(iconn(1+i,ipdb(37)))).eq.16) 
     &          call settyp(ityp,ipdb(37),82)
         end do
      endif

      if (jres.eq.17) then
         if (ihis.eq.2) then
             call settyp(ityp,ipdb(6),43)
             call settyp(ityp,ipdb(11),44)
             call settyp(ityp,ipdb(13),46)
             call settyp(ityp,ipdb(20),69)
             call settyp(ityp,ipdb(24),68)
         endif
         if (ihis.eq.3) then
             call settyp(ityp,ipdb(6),44)
             call settyp(ityp,ipdb(11),43)
             call settyp(ityp,ipdb(13),46)
             call settyp(ityp,ipdb(20),68)
             call settyp(ityp,ipdb(24),69)
         endif
      endif
      
      if (ihashy.eq.1) then

         n = 0
         do i=1,3
            if (ihpdb(i).ne.0) n = n + 1
         end do
         nterm = .false.
         if (n.eq.3.or.(jres.eq.15.and.n.eq.2)) nterm = .true.

         if (nterm) then
c H
            nt = 6
            if (jres.eq.15) nt = 7
            do i=1,n
               call settyp(ityp,ihpdb(i),nt)
            end do

c N
            nt = 65
            if (jres.eq.15.and.n.eq.2) nt = 67
            call settyp(ityp,ipdb(1),nt)

c CA
            nt = 23
            if (jres.eq.1) nt = 29
            if (jres.eq.15) nt = 33
            call settyp(ityp,ipdb(2),nt)

c CD
            if (jres.eq.15) call settyp(ityp,ipdb(9),34)

         else
            call settyp(ityp,ihpdb(1),3)
         endif
c HA
         nt = 4
         if (nterm.and.jres.ne.1) nt = 5
         call settyp(ityp,ihpdb(4),nt)
         call settyp(ityp,ihpdb(5),nt)

c HB, HG
         do i=1,3
            call settyp(ityp,ihpdb(6+i),1)
            call settyp(ityp,ihpdb(9+i),1)
         end do

         do i=1,nhh(jres)
            call settyp(ityp,ihpdb(ihh(1,i,jres)),ihh(2,i,jres))
         end do

c check for lysine alternative HZ1,HZ2,HZ3 instead of 1HZ,2HZ,3HZ

         if (jres.eq.12) then
            call settyp(ityp,ihpdb(43),6)
            call settyp(ityp,ihpdb(46),6)
            call settyp(ityp,ihpdb(49),6)
         endif

         if (jres.eq.17) then
            if (ihis.eq.2) then
                call settyp(ityp,ihpdb(22),11)
                call settyp(ityp,ihpdb(25),14)
                call settyp(ityp,ihpdb(31),12)
            endif
            if (ihis.eq.3) then
                call settyp(ityp,ihpdb(25),15)
                call settyp(ityp,ihpdb(31),12)
                call settyp(ityp,ihpdb(34),11)
            endif
         endif
      endif

      return
      end

