force legacy standard for gfortran
[unres.git] / 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