      subroutine rdpdd(istat,coo,ianz)
      implicit double precision (a-h,o-z)

      parameter (numcal=5000)
      parameter (mxchai=50)
      parameter (mxheta=50)
      parameter (mxres=42)
      parameter (mxel=100)
      integer reson
      common /calf/ icalf(6,numcal),ncalf,ianf(mxchai),islu(mxchai),
     &              nchain,iamino(numcal),iamicl(mxres),ihet(mxheta),
     &              iclhet(mxheta),reson(numcal),issdon
      character*1 achain
      common /helix/ isal(numcal),irsnr(numcal),ibck(4),achain(numcal),
     &               ihashb,ishoh
      common /athlp/ iatoms, mxnat
      common /rdwr/  iun1,iun2,iun3,iun4,iun5
      character*2 elemnt
      common /elem/elemnt(mxel)
      character lstr*137
      character*2 tstr,tocapf
      dimension coo(3,*),ianz(*)

      ihashb = 0

      rewind iun2
      istat = 1
      
10    call searchd(lstr,'ATOM','HETATM',istat)
      if (istat.eq.0) then
           call inferr('no ATOM/HETATM found !',0)
           goto 100
      endif
      if (lstr(1:4).ne.'ATOM'.and.lstr(1:6).ne.'HETATM') goto 10
      backspace iun2

      iatoms = 0
      do while (.true.)
15        read(iun2,'(a)',end=20) lstr
          if (lstr(1:4).ne.'ATOM'.and.lstr(1:6).ne.'HETATM') goto 15
          if (iatoms.ge.mxnat) then
               call inferr('exceeded maximum atoms !',1)
               goto 100
          endif
          iatoms = iatoms + 1
          ianz(iatoms) = 0
          read(lstr,'(12x,a2,16x,3f8.3)') tstr,
     &        coo(1,iatoms),coo(2,iatoms),coo(3,iatoms)
          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.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.eq.tocapf(elemnt(j))) ianz(iatoms) = j
             end do
          endif
          if (ianz(iatoms).le.0) then
             if (tstr(2:2).eq.'D') then
                ianz(iatoms) = 1
             else
                write(iun3,*) 'Unclassified atom =',tstr
                write(iun3,*) lstr
                ianz(iatoms) = 99
             endif
          endif
      end do

20    continue

      return
100   istat = 0
      return
      end

      subroutine pdbsdd(istat,doscnd,ioadd,
     &                  coo,ianz,iaton,iresid,iconn,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxchtp=136)
      parameter (mxamb=701)
      parameter (mxgff=71)
      parameter (mxamo=201)
      integer*2 ityp
      character*3 chtnk,pdbsym,hsym,ambtnk
      character*2 amotnk,gffstr
      common /symbol/ pdbsym(mxsym),hsym(mxhsym),chtnk(mxchtp),
     &                ambtnk(mxamb),amotnk(mxamo),gffstr(mxgff)
      common /athlp/ iatoms, mxnat
      common /surf/ natorg,nosncd

      parameter (numcal=5000)
      parameter (mxchai=50)
      parameter (mxheta=50)
      parameter (mxres=42)
      parameter (mxmmul=100)
      integer reson
      common /calf/ icalf(6,numcal),ncalf,ianf(mxchai),islu(mxchai),
     &              nchain,iamino(numcal),iamicl(mxres),ihet(mxheta),
     &              iclhet(mxheta),reson(numcal),issdon
      character*1 achain
      common /helix/ isal(numcal),irsnr(numcal),ibck(4),achain(numcal),
     &               ihashb,ishoh
      logical isatm,ishet,hasalt,doscnd,skip,dall
      character*3 aminos
      common /amino/ aminos(mxres)
      common /multim/imulm, nmulm,ihasqm(mxmmul)

      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
      character*3 resi
      character*1 restmp,resa,altloc,aloc,ach
      dimension ipdb(mxsym),hetred(4),
     &          ihpdb(mxhsym*3),tmp(3),isc(numcal)
      dimension coo(3,*),ianz(*),iaton(*),iresid(*),iconn(mxcon+1,*),
     &          ityp(*)

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

      imulm = 1
      if (ioadd.eq.0) then
         call parsfn('Helix',5,1)
         call parsfn('Beta',4,1)
         call parsfn('RNA/DNA',7,1)
         call parsfn('Coil',4,1)
      endif

      ihashb = 0


      ioatms = 0
      if (ioadd.eq.1) then
         natorg = iatoms
         do i=ncalf+1,numcal
             isal(i) = 3
             isc(i) = 3
         end do
         noff = ncalf
         ioatms = iatoms
      else
         do i=1,numcal
             isal(i) = 3
             isc(i) = 3
         end do
         noff = 0
      endif

      if (.not.doscnd) goto 5

c
c     Proces Helix/Sheet information
c
      rewind iun2

      do while (.true.)
          call searchd(lstr,'HELIX','SHEET',istat)
          if (istat.eq.0) goto 5
          if (index(lstr,'HELIX').eq.1) then
             read(lstr,'(21x,i4,8x,i4)',err=4,end=4) 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
                do i=i1,i2
                   isc(noff+i) = 0
                end do
             endif
          elseif (index(lstr,'SHEET').eq.1) then
             read(lstr,'(22x,i4,7x,i4)',err=4,end=4) 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
                do i=i1,i2
                   isc(noff+i) = 1
                end do
             endif
          endif
      end do
4     call inferr('Error reading HELIX/SHEET record !',0)
5     continue

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

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

      if (ioadd.eq.1) then
         call numhet(nhmol)
         nmulm = nhmol - 3
         nmulmt = nmulm
         icres = ncalf
         ianf(nchain+1) = 1
         islu(nchain+1) = 0
      else
         nhmol = 3
         iatoms = 0
         icres = 0
         nchain = 1
         ianf(1) = 1
         islu(1) = 0
         nmulm = 0
      endif

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

      do while (.true.)
15        read(iun2,'(a)',end=20) lstr
          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)
           
          jrest = 0
          if (resi(2:3).eq.'  ') resi = '  '//resi(1:1)
          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(2:4).eq.'OT ') tstr(2:4) = 'OXT'
          if (tstr(2:4).eq.'OCT') tstr(2:4) = 'OXT'
          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.
             else
c                if (icres.gt.0.and.jres.ne.0) then
                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) 
     &              isal(icres) = isc(iresnr)
             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
          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)
          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

      rewind iun2
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
      backspace iun2

      do while (.true.)
215        read(iun2,'(a)',end=220) lstr
           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)
              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,2x,i4,4x,3f8.3)') tstr,altloc,
     &        resi,iresnr, coo(1,iatoms),coo(2,iatoms),coo(3,iatoms)
           
           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.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
           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) then
              irtmp = iresnr
              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)
                     ishoh = nhmol
                  endif  
              else
                  nhmol = nhmol + 1
                  if (nmulm.lt.mxmmul) nmulm = nmulm + 1
                  call parsfn(resi,3,1)
              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=ioatms+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
         do i=nmulmt,nmulm
            ihasqm(i) = 0
         end do
         if (nmulmt.eq.0) nmulmt = 1
         do i=nmulmt+4,nhmol+1
            ihet(i) = 1
         end do
      endif

      if (hasalt) call inferr('Alternate location(s) detected',0)
      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) call inferr('Alternate location(s) detected',0)
      return
      end

      subroutine conpdd(ianz,iconn,iresid)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (numcal=5000)
      parameter (mxchai=50)
      parameter (mxheta=50)
      parameter (mxres=42)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      common /athlp/ iatoms, mxnat
      integer reson
      common /calf/ icalf(6,numcal),ncalf,ianf(mxchai),islu(mxchai),
     &              nchain,iamino(numcal),iamicl(mxres),ihet(mxheta),
     &              iclhet(mxheta),reson(numcal),issdon
      dimension ipdb(mxsym),ihpdb(mxhsym*3)
      dimension iconn(mxcon+1,*),ianz(*),iresid(*)

      namatm = 0

      do i=1,iatoms
         iconn(1,i) = 0
         if (iresid(i).le.0.and.namatm.eq.0) namatm = i-1
      end do

      if (namatm.eq.0) namatm = iatoms

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

c
c do connectivity between all except amino-amino
c
      nhet = iatoms - namatm

      do ii=1,nhet

         i = namatm + ii
         ir1 = iresid(i)

         do j=1,namatm + ii - 1
            ir2 = iresid(j)
            if (.not.(ir1.gt.0.and.ir2.gt.0)) then
               call connij(idum,i,j,1)
            endif
         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(idcon,ii,jj,1)
                     if (idcon.eq.1) then
                        do l=1,iconn(1,ii)
                           ll = iabs(iconn(l+1,ii))
                        end do
                        do l=1,iconn(1,jj)
                           ll = iabs(iconn(l+1,jj))
                        end do
                     endif
                  endif
               endif
            end do
         endif
      end do

      return
      end

      subroutine convpdd(ianz,iconn,iresid)
c same as conpdb, only before conversion to angstrom
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (numcal=5000)
      parameter (mxchai=50)
      parameter (mxheta=50)
      parameter (mxres=42)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      common /athlp/ iatoms, mxnat
      integer reson
      common /calf/ icalf(6,numcal),ncalf,ianf(mxchai),islu(mxchai),
     &              nchain,iamino(numcal),iamicl(mxres),ihet(mxheta),
     &              iclhet(mxheta),reson(numcal),issdon
      common /cllab/ iclon,iclpnt(4)
      dimension ipdb(mxsym),ihpdb(mxhsym*3)
      dimension iconn(mxcon+1,*),ianz(*),iresid(*)

      namatm = 0
      do i=1,iatoms
         iconn(1,i) = 0
         if (iresid(i).le.0.and.namatm.eq.0) namatm = i-1
      end do
      if (namatm.eq.0) namatm = iatoms

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

c
c do connectivity between all except amino-amino
c
      nhet = iatoms - namatm
      do ii=1,nhet
         i = namatm + ii
         ir1 = iresid(i)
         do j=1,namatm + ii - 1
            ir2 = iresid(j)
            if (ir1.eq.ir2.and..not.(ir1.gt.0.and.ir2.gt.0)) then
               call connij(idum,i,j,0)
            endif
         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(idcon,ii,jj,0)
                     if (idcon.eq.1) then
                        do l=1,iconn(1,ii)
                           ll = iabs(iconn(l+1,ii))
                        end do
                        do l=1,iconn(1,jj)
                           ll = iabs(iconn(l+1,jj))
                        end do
                     endif
                  endif
               endif
            end do
         endif
      end do

      return
      end

      subroutine consld(iconn,iresid)
c same as conpdb, only before conversion to angstrom, non residue
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (numcal=5000)
      common /athlp/ iatoms, mxnat
      character*1 achain
      common /helix/ isal(numcal),irsnr(numcal),ibck(4),achain(numcal),
     &               ihashb,ishoh
      dimension iconn(mxcon+1,*),iresid(*)

      namatm = 0
      do i=1,iatoms
         if (iresid(i).lt.-3) then
            iconn(1,i) = 0
         endif
         if (iresid(i).lt.-3.and.namatm.eq.0) namatm = i-1
      end do
      if (namatm.eq.0) namatm = iatoms

c
c do connectivity between all except amino-amino
c
      nhet = iatoms - namatm
      do ii=1,nhet
         i = namatm + ii
         ir1 = iresid(i)
         do j=1,namatm + ii - 1
            ir2 = iresid(j)
            if (ir1.eq.ir2) then
               call connij(idcon,i,j,0)
            endif
         end do
      end do

      return
      end
c
      subroutine connid(idcon,i,j,idoconv,iconn,ianz,coo)
      implicit double precision (a-h,o-z)
      parameter (mxel=100)
      parameter (mxcon=10)
      common /thephi/theta1,phi1,rroot,rincr,vdwr(mxel),vrad(mxel),
     &               scal,fscal,scali,smag,ipoints,ipnt,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

      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 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 too
         call conath(ipdb,ihpdb,12,31)
         call conath(ipdb,ihpdb,12,34)

         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)
      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)
      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 pdbtyd(ipdb,ihpdb,jres,ihashy,ipdbt)
      implicit double precision (a-h,o-z)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      integer*2 ipdbt
      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 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
      integer*2 ityp
      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

      subroutine typamd(ipdb,jres,ihpdb,ihashy,
     &                  ianz,iconn,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxrss=20)
      parameter (mxrsa=23)
      parameter (mxata=9)
      parameter (mxatha=9)
      parameter (mxrso=24)
      parameter (mxato=10)
      parameter (mxatho=11)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxamb=701)
      parameter (mxambc=49)
      logical nterm,cterm
      integer*2 ityp
      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)
      integer ambvdt
      common /fcharg/ ambchg(mxamb),ambvw1(mxambc),ambvw2(mxambc),
     &                ambvdt(mxamb)

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

      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.mxrss) return

      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.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
         do i=1,iconn(1,ipdb(37))
            if (ianz(abs(iconn(1+i,ipdb(37)))).eq.16) 
     &          iss = 1
         end do
      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)

      if (jres.eq.15) then
         call settyp(ityp,ihpdb(4),ioff+4)
         call settyp(ityp,ihpdb(5),ioff+4)
      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.15) then
         if (nterm) then
            call settyp(ityp,ipdb(9),410)
            call settyp(ityp,ihpdb(19),411)
            call settyp(ityp,ihpdb(20),411)
         endif
CNF  Nothing different between PRO and other residues for the C-Term case
CNF         if (cterm) then
CNF            call settyp(ityp,ipdb(9),412)
CNF            call settyp(ityp,ihpdb(19),413)
CNF            call settyp(ityp,ihpdb(20),413)
CNF         endif
      endif

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

      if (jres.eq.12) then
         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

      return
      end

      subroutine typado(ipdb,jres,ihpdb,ihashy,
     &                  ianz,iconn,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxcon=10)
      parameter (mxrss=20)
      parameter (mxrsa=23)
      parameter (mxata=9)
      parameter (mxatha=9)
      parameter (mxrso=24)
      parameter (mxato=10)
      parameter (mxatho=11)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxamb=701)
      parameter (mxambc=49)
      logical nterm,cterm
      integer*2 ityp
      common /types/ iff
      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)

      integer ambvdt
      common /fcharg/ ambchg(mxamb),ambvw1(mxambc),ambvw2(mxambc),
     &                ambvdt(mxamb)

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

      iff = 4

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.mxrss) return

      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.3.or.(jres.eq.15.and.n.eq.2)) nterm = .true.
      cterm = .false.
      if (ipdb(38).ne.0) cterm = .true.

      ihis = 0
      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

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

      iasph = 0
      iasphh = 0
      if (jres.eq.9) then
c iasph is it aspartate or aspartic acid
         if (ipdb(28).ne.0) then
            do i=1,iconn(1,ipdb(28))
               if (ianz(abs(iconn(1+i,ipdb(28)))).eq.1) then
                   iasph = 28
                   iasphh = iabs(iconn(1+i,ipdb(28)))
               endif
            end do
         endif
         if (ipdb(29).ne.0) then
            do i=1,iconn(1,ipdb(29))
               if (ianz(abs(iconn(1+i,ipdb(29)))).eq.1) then
                   iasph = 29
                   iasphh = iabs(iconn(1+i,ipdb(29)))
               endif
            end do
         endif
         if (ipdb(30).ne.0) then
            do i=1,iconn(1,ipdb(30))
               if (ianz(abs(iconn(1+i,ipdb(30)))).eq.1) then
                   iasph = 30
                   iasphh = iabs(iconn(1+i,ipdb(30)))
               endif
            end do
         endif
      endif

      ioff = 7

      if (jres.eq.1) ioff = 1
      if (jres.eq.15) ioff = 50

c N
      if (nterm) then
         if (jres.eq.15) then
            call settyp(ityp,ipdb(1),194)
         else
            call settyp(ityp,ipdb(1),190)
         endif
      else
         call settyp(ityp,ipdb(1),ioff)
      endif
c CA
      if (jres.eq.3) then
         call settyp(ityp,ipdb(2),33)
      elseif (jres.eq.4) then
         call settyp(ityp,ipdb(2),44)
      elseif (jres.eq.15.and.nterm) then
         call settyp(ityp,ipdb(2),196)
      else
         call settyp(ityp,ipdb(2),ioff+1)
      endif
         
c C
      call settyp(ityp,ipdb(3),ioff+2)
      if (cterm) call settyp(ityp,ipdb(3),192)
      if (jres.eq.15.and.nterm) call settyp(ityp,ipdb(3),197)

c HN
      if (nterm) then
         if (jres.eq.15) then
            call settyp(ityp,ihpdb(1),195)
            call settyp(ityp,ihpdb(2),195)
            call settyp(ityp,ihpdb(3),195)
         else
            call settyp(ityp,ihpdb(1),191)
            call settyp(ityp,ihpdb(2),191)
            call settyp(ityp,ihpdb(3),191)
         endif
         
      else
         call settyp(ityp,ihpdb(1),ioff+3)
         call settyp(ityp,ihpdb(2),ioff+3)
         call settyp(ityp,ihpdb(3),ioff+3)
      endif

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


c HA
      if (jres.eq.15) then
         if (nterm) then
            call settyp(ityp,ihpdb(4),199)
            call settyp(ityp,ihpdb(5),199)
         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

      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
      if (jres.eq.9.and.iasph.ne.0) jtmp = 24
    
      do i=1,ncco(jtmp)
         call settyp(ityp,ipdb(icco(1,i,jtmp)),icco(2,i,jtmp))
      end do

      do i=1,nhho(jtmp)
         call settyp(ityp,ihpdb(ihho(1,i,jtmp)),ihho(2,i,jtmp))
      end do

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

      if (jres.eq.9.and.iasph.ne.0) then
         call settyp(ityp,ipdb(iasph),136)
         if (iasphh.ne.0) call settyp(ityp,iasphh,137)
c         call settyp(ityp,ihpdb(19),137)
c         call settyp(ityp,ihpdb(20),137)
c         call settyp(ityp,ihpdb(21),137)
      endif

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

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

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

      return
      end

      subroutine settyp(itypa,iat,ityp)
      implicit double precision (a-h,o-z)
      integer*2 itypa
      dimension itypa(*)
      common /typoni/ ioniad

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

      return
      end

      subroutine setchd(iat,iopt,qat,ityp)
      implicit double precision (a-h,o-z)
      parameter (mxamb=701)
      parameter (mxambc=49)
      integer*2 ityp,it,it10000
      common /typoni/ ioniad
      common /charge/ dipo(3),ihasq,ihsdp,iqon,idipon
      integer ambvdt
      common /fcharg/ ambchg(mxamb),ambvw1(mxambc),ambvw2(mxambc),
     &                ambvdt(mxamb)
      dimension qat(*),ityp(*)

      it10000=10000


      if (iat.gt.0) then
         if (iopt.eq.1) then
            if (ioniad.gt.0) then
               it = mod(ityp(iat),it10000)
            else
               it = ityp(iat)
            endif
            if (it.gt.0) then
               qat(iat) = ambchg(int(it))
            endif
            ihasq = 1
         else
            qat(iat) = 0.0d0
         endif
      endif

      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 mkbacd(ipdb,ihpdb,jres,icres,ihashy,idoconv,
     &                  iconn,coo)
      implicit double precision (a-h,o-z)
      parameter (numcal=5000)
      parameter (mxchai=50)
      parameter (mxheta=50)
      parameter (mxres=42)
      parameter (mxcon=10)
      logical newch
      integer reson
      common /calf/ icalf(6,numcal),ncalf,ianf(mxchai),islu(mxchai),
     &              nchain,iamino(numcal),iamicl(mxres),ihet(mxheta),
     &              iclhet(mxheta),reson(numcal),issdon
      dimension ipdb(*),ihpdb(*),tmp(3),coo(3,*),iconn(mxcon+1,*)

      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.
         if (iamino(icres-1).le.23) then
            in = ipdb(1)
            ic = icalf(3,icres-1)
            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
      endif

      return
      end

      subroutine mknbcd(ipdb,ihpdb,jres,icres,ihashy,idoconv,
     &                  iconn,coo)
      implicit double precision (a-h,o-z)
      parameter (numcal=5000)
      parameter (mxchai=50)
      parameter (mxheta=50)
      parameter (mxres=42)
      parameter (mxcon=10)
      logical newch
      integer reson
      common /calf/ icalf(6,numcal),ncalf,ianf(mxchai),islu(mxchai),
     &              nchain,iamino(numcal),iamicl(mxres),ihet(mxheta),
     &              iclhet(mxheta),reson(numcal),issdon
      dimension ipdb(*),ihpdb(*),tmp(3),coo(3,*),iconn(mxcon+1,*)

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

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

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


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

      iconn(1,ipdb(47)) = 2
      iconn(2,ipdb(47)) = ipdb(46)
      iconn(3,ipdb(47)) = ipdb(48)
      iconn(1,ipdb(48)) = 3
      iconn(2,ipdb(48)) = ipdb(47)
      iconn(3,ipdb(48)) = ipdb(49)
      iconn(4,ipdb(48)) = ipdb(50)
      iconn(1,ipdb(49)) = 2
      iconn(2,ipdb(49)) = ipdb(48)
      iconn(3,ipdb(49)) = ipdb(54)
      iconn(1,ipdb(50)) = 3
      iconn(2,ipdb(50)) = ipdb(48)
      iconn(3,ipdb(50)) = ipdb(51)
      iconn(4,ipdb(50)) = ipdb(52)
      iconn(1,ipdb(51)) = 1
      iconn(2,ipdb(51)) = ipdb(50)
      iconn(1,ipdb(52)) = 2
      iconn(2,ipdb(52)) = ipdb(50)
      iconn(3,ipdb(52)) = ipdb(54)
      if (ipdb(53).ne.0) then
         iconn(1,ipdb(52)) = 3
         iconn(4,ipdb(52)) = ipdb(53)
         iconn(1,ipdb(53)) = 1
         iconn(2,ipdb(53)) = ipdb(52)
      endif
      iconn(1,ipdb(54)) = 2
      iconn(2,ipdb(54)) = ipdb(49)
      iconn(3,ipdb(54)) = ipdb(52)

c Possible OXT
      if (ipdb(38).ne.0.and.ipdb(43).ne.0) then
         iconn(1,ipdb(43)) = 4
         iconn(5,ipdb(43)) = ipdb(38)
         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
         iconn(1,ipdb(43)) = 4
         iconn(5,ipdb(43)) = ipdb(76)
         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.ipdb(46).ne.0.and.icres.le.numcal) 
     &    icalf(1,icres) = ipdb(46)

      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)
            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)
            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 addhd(ires,jres,ipdb,ihpdb,nterm,
     &                 ianz,iaton,iatclr,iresid,iconn,isurf,ipdbt,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)
      integer*2 ipdbt
      logical addat
      dimension ipdb(*), ihpdb(*), it(4), rt(4)
      dimension ianz(*),iaton(*),iatclr(*),iconn(mxcon+1,*),
     &          iresid(*),coo(3,*),ipdbt(*),isurf(*)
      data nrs /2,4,4,4,6,10,8,8,3,5,10,12,5,7,7,12,7,8,8,9,3*0,
     &          11,11,11,12,10,15,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, 13,11,24,34, 24,6,11,25,
     &     32*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,-136,
     &     60,58,64,-137, 58,60,79,148, 58,60,79,149, 58,60,79,150, 
     &     60,57,58,103/
      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.010d0,120.0d0,0.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/

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,66,65,59,113,58,55,60,-121, 60,55,61,-124, 
     &     60,55,61,-125,
     &     57,65,85,166, 57,65,85,167, 57,65,85,168/
      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,120.0d0, 1.080d0,122.0d0,-120.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/

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))
          ihp = ihpdb(ih)

          if (jres.eq.4.and.i.eq.2) then
              if (iconn(1,ipdb(37)).gt.1) ihp = 1
          endif
          if (jres.eq.12.and.i.ge.10) then
              n = iconn(1,ipdb(27)) - 1
              if (n.gt.2) ihp = 1
          endif
          if (jres.eq.17.and.i.eq.6) then
              if (iconn(1,ipdb(24)).gt.2) ihp = 1
          endif
          if (ihp.eq.0) then
              if (addat(ipdb(it(1)),ipdb(it(2)),
     &        ipdb(it(3)),1,rt(1),rt(2),rt(3),ihpdb(ih),
     &            ianz,iaton,iatclr,iconn,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),
     &            ianz,iaton,iatclr,iconn,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),
     &            ianz,iaton,iatclr,iconn,coo)) then
                    iresid(ihpdb(115)) = ires
                    ipdbt(ihpdb(115)) = 115
                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),
     &            ianz,iaton,iatclr,iconn,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),
     &            ianz,iaton,iatclr,iconn,coo)) then
                   iresid(ihpdb(3)) = ires
                   ipdbt(ihpdb(3)) = 3
               endif
            endif
         endif

      endif

      return
      end

      subroutine rdprot
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      parameter (mxres=42)
      parameter (maxam=1000)
      character*137 line,string
      common /curlin/ line
      character*3 aminos
      common /amino/  aminos(mxres)
      integer getlin
      dimension iamin(maxam),angs(7,maxam)

      mxam = maxam
      namin = 0
      do while (getlin(0).eq.1)
         iam = 0
         ktype = nxtwrd(string,nstr,itype,rtype)
         if (ktype.eq.1.and.nstr.eq.3) then
             call tocap(string,3)
             do i=1,20
                if (string(1:3).eq.aminos(i)) iam = i
             end do
             if (iam.ne.0) then
                if (namin.lt.maxam) then
                   namin = namin + 1
                   iamin(namin) = iam - 1
                   do i=1,7
                      angs(i,namin) = -1
                      ktype = nxtwrd(string,nstr,itype,rtype)
                      if (ktype.eq.3) angs(i,namin) = rtype
                      if (ktype.eq.2) angs(i,namin) = dble(itype)
                   end do
                else
                   call inferr('To many RESIDUES !',0)
                endif
             endif
         endif
      end do

      call readsq(iamin,angs,namin)

      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

      logical function chkpdb(ipdb,jres,icres)
      implicit double precision (a-h,o-z)
      parameter (mxres=42)
      parameter (mxares=20)
      parameter (mxaat=13)
      parameter (mxsym=103)
      parameter (mxhsym=64)
      parameter (mxchtp=136)
      parameter (mxamb=701)
      parameter (mxgff=71)
      parameter (mxamo=201)
      parameter (numcal=5000)
      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),chtnk(mxchtp),
     &                ambtnk(mxamb),amotnk(mxamo),gffstr(mxgff)
      character*1 achain
      common /helix/ isal(numcal),irsnr(numcal),ibck(4),achain(numcal),
     &               ihashb,ishoh
      dimension ipdb(*)

      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(resat(jres,i)).le.0) then
               chkpdb = .false.
               print*,'incomplete residue ',irsnr(icres),' ',
     &                 aminos(jres),' ',pdbsym(resat(jres,i))
               return
            endif
         end do
      endif

      chkpdb = .true.
      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 '
          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
