source/cluster/wham/src/readpdb.f

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