source/cluster/unres/src/readpdb.f

   1       subroutine readpdb
   2 C Read the PDB file and convert the peptide geometry into virtual-chain
   3 C geometry.
   4       include 'DIMENSIONS'
   5       include 'COMMON.LOCAL'
   6       include 'COMMON.VAR'
   7       include 'COMMON.CHAIN'
   8       include 'COMMON.INTERACT'
   9       include 'COMMON.IOUNITS'
  10       include 'COMMON.GEO'
  11       include 'COMMON.NAMES'
  12       character*3 seq,atom,res
  13       character*80 card
  14       dimension sccor(3,20)
  15       integer rescode
  16       ibeg=1
  17       do i=1,10000
  18         read (ipdbin,'(a80)',end=10) card
  19         if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10
  20 C Fish out the ATOM cards.
  21         if (index(card(1:4),'ATOM').gt.0) then
  22           read (card(14:16),'(a3)') atom
  23           if (atom.eq.'CA' .or. atom.eq.'CH3') then
  24 C Calculate the CM of the preceding residue.
  25             if (ibeg.eq.0) call sccenter(ires,iii,sccor)
  26 C Start new residue.
  27             read (card(24:26),*) ires
  28             read (card(18:20),'(a3)') res
  29             if (ibeg.eq.1) then
  30               ishift=ires-1
  31               if (res.ne.'GLY' .and. res.ne. 'ACE') then
  32                 ishift=ishift-1
  33                 itype(1)=21
  34               endif
  35               ibeg=0
  36             endif
  37             ires=ires-ishift
  38             if (res.eq.'ACE') then
  39               ity=10
  40             else
  41               itype(ires)=rescode(ires,res,0)
  42             endif
  43             read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
  44             write (iout,'(2i3,2x,a,3f8.3)')
  45      &      ires,itype(ires),res,(c(j,ires),j=1,3)
  46             iii=1
  47             do j=1,3
  48               sccor(j,iii)=c(j,ires)
  49             enddo
  50           else if (atom.ne.'O  '.and.atom(1:1).ne.'H' .and.
  51      &             atom.ne.'N  ' .and. atom.ne.'C   ') then
  52             iii=iii+1
  53             read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
  54           endif
  55         endif
  56       enddo
  57    10 write (iout,'(a,i5)') ' Nres: ',ires
  58 C Calculate the CM of the last side chain.
  59       call sccenter(ires,iii,sccor)
  60       nres=ires
  61       nsup=nres
  62       nstart_sup=1
  63       if (itype(nres).ne.10) then
  64         nres=nres+1
  65         itype(nres)=21
  66         do j=1,3
  67           dcj=c(j,nres-2)-c(j,nres-3)
  68           c(j,nres)=c(j,nres-1)+dcj
  69           c(j,2*nres)=c(j,nres)
  70         enddo
  71       endif
  72       do i=2,nres-1
  73         do j=1,3
  74           c(j,i+nres)=dc(j,i)
  75         enddo
  76       enddo
  77       do j=1,3
  78         c(j,nres+1)=c(j,1)
  79         c(j,2*nres)=c(j,nres)
  80       enddo
  81       if (itype(1).eq.21) then
  82         nsup=nsup-1
  83         nstart_sup=2
  84         do j=1,3
  85           dcj=c(j,4)-c(j,3)
  86           c(j,1)=c(j,2)-dcj
  87           c(j,nres+1)=c(j,1)
  88         enddo
  89       endif
  90 C Copy the coordinates to reference coordinates
  91       do i=1,2*nres
  92         do j=1,3
  93           cref(j,i)=c(j,i)
  94         enddo
  95       enddo
  96 C Calculate internal coordinates.
  97 c     do ires=1,nres
  98 c       write (iout,'(2i3,2x,a,3f8.3)')
  99 c    &    ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3)
 100 c     enddo
 101       if (itype(1).eq.21) then
 102         nnt=2
 103       else
 104         nnt=1
 105       endif
 106       if (itype(nres).eq.21) then
 107         nct=nres-1
 108       else
 109         nct=nres
 110       endif
 111       do i=1,2*nres
 112         do j=1,3
 113           cref_pdb(j,i)=c(j,i)
 114         enddo
 115       enddo
 116       call int_from_cart(.true.,.true.)
 117       return
 118       end
 119 c---------------------------------------------------------------------------
 120       subroutine int_from_cart(lside,lprn)
 121       include 'DIMENSIONS'
 122       include 'COMMON.LOCAL'
 123       include 'COMMON.VAR'
 124       include 'COMMON.CHAIN'
 125       include 'COMMON.INTERACT'
 126       include 'COMMON.IOUNITS'
 127       include 'COMMON.GEO'
 128       include 'COMMON.NAMES'
 129       character*3 seq,atom,res
 130       character*80 card
 131       dimension sccor(3,20)
 132       integer rescode
 133       logical lside,lprn
 134       if (lprn) then
 135         write (iout,'(/a)')
 136      &  'Internal coordinates calculated from crystal structure.'
 137         if (lside) then
 138           write (iout,'(8a)') '  Res  ','       dvb','     Theta',
 139      & '       Phi','    Dsc_id','       Dsc','     Alpha',
 140      & '     Omega'
 141         else
 142           write (iout,'(4a)') '  Res  ','       dvb','     Theta',
 143      & '       Phi'
 144         endif
 145       endif
 146       do i=nnt+1,nct
 147         iti=itype(i)
 148         if (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0) then
 149           write (iout,'(a,i4)') 'Bad Cartesians for residue',i
 150           stop
 151         endif
 152         theta(i+1)=alpha(i-1,i,i+1)
 153         if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1)
 154       enddo
 155       if (lside) then
 156         do i=nnt,nct
 157           do j=1,3
 158             if (nnt.gt.1) c(j,2*maxres)=0.5D0*(c(j,i-1)+c(j,i+1))
 159           enddo
 160           iti=itype(i)
 161           di=dist(i,nres+i)
 162           if (iti.ne.10) then
 163             alph(i)=alpha(nres+i,i,2*maxres)
 164             omeg(i)=beta(nres+i,i,2*maxres,i+1)
 165           endif
 166           if (lprn)
 167      &    write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1),
 168      &    rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di,rad2deg*alph(i),
 169      &    rad2deg*omeg(i)
 170         enddo
 171       else if (lprn) then
 172         do i=2,nres
 173           iti=itype(i)
 174           write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1),
 175      &    rad2deg*theta(i),rad2deg*phi(i)
 176         enddo
 177       endif
 178       return
 179       end
 180 c---------------------------------------------------------------------------
 181       subroutine sccenter(ires,nscat,sccor)
 182       include 'DIMENSIONS'
 183       include 'COMMON.CHAIN'
 184       dimension sccor(3,20)
 185       do j=1,3
 186         sccmj=0.0D0
 187         do i=1,nscat
 188           sccmj=sccmj+sccor(j,i)
 189         enddo
 190         dc(j,ires)=sccmj/nscat
 191       enddo
 192       return
 193       end