subroutine readpdb
C Read the PDB file and convert the peptide geometry into virtual-chain
C geometry.
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
+ include 'sizesclu.dat'
+ include 'COMMON.CONTROL'
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.NAMES'
character*3 seq,atom,res
character*80 card
- dimension sccor(3,20)
- integer rescode
- call permut(symetr)
+ double precision sccor(3,50)
+ integer i,j,iii,ibeg,ishift,ishift1,ity,ires,ires_old
+ double precision dcj
+ integer rescode,kkk,lll,icha,cou,kupa,iprzes
ibeg=1
+ ishift1=0
do
read (ipdbin,'(a80)',end=10) card
if (card(:3).eq.'END') then
goto 10
else if (card(:3).eq.'TER') then
C End current chain
- ires_old=ires+1
- itype(ires_old)=21
+c ires_old=ires+1
+ ires_old=ires+2
+ itype(ires_old-1)=ntyp1
+ itype(ires_old)=ntyp1
ibeg=2
c write (iout,*) "Chain ended",ires,ishift,ires_old
call sccenter(ires,iii,sccor)
endif
C Start new residue.
c write (iout,'(a80)') card
- read (card(24:26),*) ires
+ read (card(23:26),*) ires
read (card(18:20),'(a3)') res
if (ibeg.eq.1) then
ishift=ires-1
if (res.ne.'GLY' .and. res.ne. 'ACE') then
ishift=ishift-1
- itype(1)=21
+ itype(1)=ntyp1
endif
c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift
ibeg=0
sccor(j,iii)=c(j,ires)
enddo
else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and.
+ & atom(1:1).ne.'Q' .and. atom(1:2).ne.'1H' .and.
+ & atom(1:2).ne.'2H' .and. atom(1:2).ne.'3H' .and.
& atom.ne.'N ' .and. atom.ne.'C ') then
iii=iii+1
read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
nres=ires
do i=2,nres-1
c write (iout,*) i,itype(i)
- if (itype(i).eq.21) then
-c write (iout,*) "dummy",i,itype(i)
- do j=1,3
- c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2
-c c(j,i)=(c(j,i-1)+c(j,i+1))/2
- dc(j,i)=c(j,i)
- enddo
- endif
+
+ if (itype(i).eq.ntyp1) then
+ if (itype(i+1).eq.ntyp1) then
+C 16/01/2014 by Adasko: Adding to dummy atoms in the chain
+C first is connected prevous chain (itype(i+1).eq.ntyp1)=true
+C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false
+C if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the last dummy residue
+C call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
+C if (fail) then
+C e2(1)=0.0d0
+C e2(2)=1.0d0
+C e2(3)=0.0d0
+C endif !fail
+C do j=1,3
+C c(j,i)=c(j,i-1)-1.9d0*e2(j)
+C enddo
+C else !unres_pdb
+ do j=1,3
+ dcj=(c(j,i-2)-c(j,i-3))/2.0
+ c(j,i)=c(j,i-1)+dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+C endif !unres_pdb
+ else !itype(i+1).eq.ntyp1
+C if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the first dummy residue
+C call refsys(i+1,i+2,i+3,e1,e2,e3,fail)
+C if (fail) then
+C e2(1)=0.0d0
+C e2(2)=1.0d0
+C e2(3)=0.0d0
+C endif
+C do j=1,3
+C c(j,i)=c(j,i+1)-1.9d0*e2(j)
+C enddo
+C else !unres_pdb
+ do j=1,3
+ dcj=(c(j,i+3)-c(j,i+2))/2.0
+ c(j,i)=c(j,i+1)-dcj
+ c(j,nres+i)=c(j,i)
+ enddo
+C endif !unres_pdb
+ endif !itype(i+1).eq.ntyp1
+ endif !itype.eq.ntyp1
enddo
C Calculate the CM of the last side chain.
call sccenter(ires,iii,sccor)
nstart_sup=1
if (itype(nres).ne.10) then
nres=nres+1
- itype(nres)=21
+ itype(nres)=ntyp1
do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
+ dcj=(c(j,nres-2)-c(j,nres-3))/2.0
c(j,nres)=c(j,nres-1)+dcj
c(j,2*nres)=c(j,nres)
enddo
c(j,nres+1)=c(j,1)
c(j,2*nres)=c(j,nres)
enddo
- if (itype(1).eq.21) then
+ if (itype(1).eq.ntyp1) then
nsup=nsup-1
nstart_sup=2
do j=1,3
- dcj=c(j,4)-c(j,3)
+ dcj=(c(j,4)-c(j,3))/2.0
c(j,1)=c(j,2)-dcj
c(j,nres+1)=c(j,1)
enddo
& (c(j,nres+ires),j=1,3)
enddo
call int_from_cart(.true.,.false.)
+c write (iout,*) "After int_from_cart"
+c call flush(iout)
do i=1,nres-1
do j=1,3
dc(j,i)=c(j,i+1)-c(j,i)
enddo
c call chainbuild
C Copy the coordinates to reference coordinates
- do i=1,2*nres
+c do i=1,2*nres
+c do j=1,3
+c cref_pdb(j,i)=c(j,i)
+c enddo
+c enddo
+C Splits to single chain if occurs
+ kkk=1
+ lll=0
+ cou=1
+ do i=1,nres
+ lll=lll+1
+cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
+ if (i.gt.1) then
+ if ((itype(i-1).eq.ntyp1).and.(i.gt.2).and.(i.ne.nres)) then
+ chain_length=lll-1
+ kkk=kkk+1
+c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
+ lll=1
+ endif
+ endif
do j=1,3
- cref(j,i)=c(j,i)
+ cref_pdb(j,i,cou)=c(j,i)
+ cref_pdb(j,i+nres,cou)=c(j,i+nres)
+ if (i.le.nres) then
+ chain_rep(j,lll,kkk)=c(j,i)
+ chain_rep(j,lll+nres,kkk)=c(j,i+nres)
+ endif
+ enddo
+ enddo
+ if (chain_length.eq.0) chain_length=nres
+ write (iout,*) chain_length
+ do j=1,3
+ chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
+ chain_rep(j,chain_length+nres,symetr)
+ &=chain_rep(j,chain_length+nres,1)
+ enddo
+c diagnostic
+
+c diagnostic
+c write (iout,*) "spraw lancuchy",chain_length,symetr
+c do i=1,24
+c do kkk=1,chain_length
+c write (iout,*) itype(kkk),(chain_rep(j,kkk,i), j=1,3)
+c enddo
+c enddo
+c enddiagnostic
+C makes copy of chains
+c write (iout,*) "symetr", symetr
+
+ if (symetr.gt.1) then
+ call permut(symetr)
+ nperm=1
+ do i=1,symetr
+ nperm=nperm*i
+ enddo
+c do i=1,nperm
+c write(iout,*) "tabperm", (tabperm(i,kkk),kkk=1,4)
+c enddo
+ do i=1,nperm
+ cou=0
+ do kkk=1,symetr
+ icha=tabperm(i,kkk)
+c write (iout,*) i,icha
+ do lll=1,chain_length
+ cou=cou+1
+ if (cou.le.nres) then
+ do j=1,3
+ kupa=mod(lll,chain_length)
+ iprzes=(kkk-1)*chain_length+lll
+ if (kupa.eq.0) kupa=chain_length
+c write (iout,*) "kupa", kupa
+ cref_pdb(j,iprzes,i)=chain_rep(j,kupa,icha)
+ cref_pdb(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha)
+ enddo
+ endif
+ enddo
enddo
+ enddo
+ endif
+C-koniec robienia kopidm
+ do kkk=1,nperm
+ write (iout,*) "nowa struktura", nperm
+ do i=1,nres
+ write (iout,110) restyp(itype(i)),i,cref_pdb(1,i,kkk),
+ &cref_pdb(2,i,kkk),
+ &cref_pdb(3,i,kkk),cref_pdb(1,nres+i,kkk),
+ &cref_pdb(2,nres+i,kkk),cref_pdb(3,nres+i,kkk)
+ enddo
+ 100 format (//' alpha-carbon coordinates ',
+ & ' centroid coordinates'/
+ 1 ' ', 6X,'X',11X,'Y',11X,'Z',
+ & 10X,'X',11X,'Y',11X,'Z')
+ 110 format (a,'(',i3,')',6f12.5)
+
enddo
ishift_pdb=ishift
end
c---------------------------------------------------------------------------
subroutine int_from_cart(lside,lprn)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
+ include 'sizesclu.dat'
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.NAMES'
character*3 seq,atom,res
character*80 card
- dimension sccor(3,20)
+ double precision sccor(3,20)
integer rescode
+ double precision dist,alpha,beta,di
+ integer i,j,iti
logical lside,lprn
if (lprn) then
write (iout,'(/a)')
& ' Phi'
endif
endif
- call flush(iout)
- do i=nnt+1,nct
+ do i=2,nres
iti=itype(i)
-c write (iout,*) i,dist(i,i-1)
- if (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0) then
+c write (iout,*) i,i-1,(c(j,i),j=1,3),(c(j,i-1),j=1,3),dist(i,i-1)
+ if (itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1 .and.
+ & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then
write (iout,'(a,i4)') 'Bad Cartesians for residue',i
stop
endif
theta(i+1)=alpha(i-1,i,i+1)
if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1)
enddo
+ if (itype(1).eq.ntyp1) then
+ do j=1,3
+ c(j,1)=c(j,2)+(c(j,3)-c(j,4))
+ enddo
+ endif
+ if (itype(nres).eq.ntyp1) then
+ do j=1,3
+ c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3))
+ enddo
+ endif
if (lside) then
do i=2,nres-1
do j=1,3
endif
if (lprn)
& write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1),
- & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di,rad2deg*alph(i),
- & rad2deg*omeg(i)
+ & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di,
+ & rad2deg*alph(i),rad2deg*omeg(i)
enddo
else if (lprn) then
do i=2,nres
end
c---------------------------------------------------------------------------
subroutine sccenter(ires,nscat,sccor)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.CHAIN'
- dimension sccor(3,20)
+ integer ires,nscat,i,j
+ double precision sccor(3,20),sccmj
do j=1,3
sccmj=0.0D0
do i=1,nscat
projects / unres.git / blobdiff