ce256df29988de07cc9e369ed77f6d9404dfba7f
[unres.git] / source / cluster / wham / src-M / geomout.F
1       subroutine pdbout(etot,rmsd,tytul)
2       implicit real*8 (a-h,o-z)
3       include 'DIMENSIONS'
4       include 'COMMON.CONTROL'
5       include 'COMMON.CHAIN'
6       include 'COMMON.INTERACT'
7       include 'COMMON.NAMES'
8       include 'COMMON.IOUNITS'
9       include 'COMMON.HEADER'
10       include 'COMMON.SBRIDGE'
11       include 'COMMON.TEMPFAC'
12       character*50 tytul
13       character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
14       dimension ica(maxres)
15       write (ipdb,'(3a,1pe15.5,a,0pf7.2)') 'REMARK ',tytul(:20),
16      &  ' ENERGY ',etot,' RMS ',rmsd
17       iatom=0
18       ichain=1
19       ires=0
20       do i=nnt,nct
21         iti=itype(i)
22         if (iti.eq.21) then
23           ichain=ichain+1
24           ires=0
25           write (ipdb,'(a)') 'TER'
26         else
27         ires=ires+1
28         iatom=iatom+1
29         ica(i)=iatom
30         write (ipdb,10) iatom,restyp(iti),chainid(ichain),
31      &     ires,(c(j,i),j=1,3)
32         if (iti.ne.10) then
33           iatom=iatom+1
34           write (ipdb,20) iatom,restyp(iti),chainid(ichain),
35      &      ires,(c(j,nres+i),j=1,3)
36         endif
37         endif
38       enddo
39       write (ipdb,'(a)') 'TER'
40       do i=nnt,nct-1
41         if (itype(i).eq.21) cycle
42         if (itype(i).eq.10 .and. itype(i+1).ne.21) then
43           write (ipdb,30) ica(i),ica(i+1)
44         else if (itype(i).ne.10 .and. itype(i+1).ne.21) then
45           write (ipdb,30) ica(i),ica(i+1),ica(i)+1
46         else if (itype(i).ne.10 .and. itype(i+1).eq.21) then
47           write (ipdb,30) ica(i),ica(i)+1
48         endif
49       enddo
50       if (itype(nct).ne.10) then
51         write (ipdb,30) ica(nct),ica(nct)+1
52       endif
53       do i=1,nss
54         write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
55       enddo
56       write (ipdb,'(a6)') 'ENDMDL'
57   10  FORMAT ('ATOM',I7,'  CA  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
58   20  FORMAT ('ATOM',I7,'  CB  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
59   30  FORMAT ('CONECT',8I5)
60       return
61       end
62 c------------------------------------------------------------------------------
63       subroutine MOL2out(etot,tytul)
64 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 
65 C format.
66       implicit real*8 (a-h,o-z)
67       include 'DIMENSIONS'
68       include 'COMMON.CHAIN'
69       include 'COMMON.INTERACT'
70       include 'COMMON.NAMES'
71       include 'COMMON.IOUNITS'
72       include 'COMMON.HEADER'
73       include 'COMMON.SBRIDGE'
74       character*32 tytul,fd
75       character*4 liczba
76       character*6 res_num,pom,ucase
77 #ifdef AIX
78       call fdate_(fd)
79 #else
80       call fdate(fd)
81 #endif
82       write (imol2,'(a)') '#'
83       write (imol2,'(a)') 
84      & '#         Creating user name:           unres'
85       write (imol2,'(2a)') '#         Creation time:                ',
86      & fd
87       write (imol2,'(/a)') '@<TRIPOS>MOLECULE'
88       write (imol2,'(a)') tytul
89       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss,nct-nnt+1,0,0
90       write (imol2,'(a)') 'SMALL'
91       write (imol2,'(a)') 'USER_CHARGES'
92       write (imol2,'(a)') '@<TRIPOS>ATOM' 
93       do i=nnt,nct
94 c        write (liczba,*) i
95         pom=ucase(restyp(itype(i)))
96 c        res_num = pom(:3)//liczba(2:)
97         write (imol2,10) i-nnt+1,(c(j,i),j=1,3),i-nnt+1,pom,0.0
98       enddo
99       write (imol2,'(a)') '@<TRIPOS>BOND'
100       do i=nnt,nct-1
101         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
102       enddo
103       do i=1,nss
104         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
105       enddo
106       write (imol2,'(a)') '@<TRIPOS>SUBSTRUCTURE'
107       do i=nnt,nct
108         write (liczba,'(i4)') i
109         pom = ucase(restyp(itype(i)))
110 c        res_num = pom(:3)//liczba(2:)
111         write (imol2,30) i-nnt+1,pom,i-nnt+1,0
112       enddo
113   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
114   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
115       return
116       end
117 c------------------------------------------------------------------------
118       subroutine intout
119       implicit real*8 (a-h,o-z)
120       include 'DIMENSIONS'
121       include 'COMMON.IOUNITS'
122       include 'COMMON.CHAIN'
123       include 'COMMON.VAR'
124       include 'COMMON.LOCAL'
125       include 'COMMON.INTERACT'
126       include 'COMMON.NAMES'
127       include 'COMMON.GEO'
128       write (iout,'(/a)') 'Geometry of the virtual chain.'
129       write (iout,'(6a)') '  Res  ','     Theta','       Phi',
130      & '       Dsc','     Alpha','      Omega'
131       do i=1,nres
132         iti=itype(i)
133         write (iout,'(a3,i4,5f10.3)') restyp(iti),i,rad2deg*theta(i),
134      &     rad2deg*phi(i),dsc(iti),rad2deg*alph(i),rad2deg*omeg(i)
135       enddo
136       return
137       end
138 c---------------------------------------------------------------------------
139       subroutine briefout(it,klasa,ener,free,nss,ihpb,jhpb,plik)
140       implicit real*8 (a-h,o-z)
141       include 'DIMENSIONS'
142       include 'COMMON.IOUNITS'
143       include 'COMMON.CHAIN'
144       include 'COMMON.VAR'
145       include 'COMMON.LOCAL'
146       include 'COMMON.INTERACT'
147       include 'COMMON.NAMES'
148       include 'COMMON.GEO'
149       dimension ihpb(maxss),jhpb(maxss)
150       character*80 plik
151 c     print '(a,i5)',intname,igeom
152 #ifdef AIX
153       open (igeom,file=plik,position='append')
154 #else
155       open (igeom,file=plik,position='append')
156 #endif
157       IF (NSS.LT.9) THEN
158         WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,NSS)
159       ELSE
160         WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,8)
161         write (igeom,'(a)') 
162         WRITE (igeom,190) (IHPB(I),JHPB(I),I=9,NSS)
163       ENDIF
164       write (igeom,'(i10)') klasa
165 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
166       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
167       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
168 c     if (nvar.gt.nphi+ntheta) then
169         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
170         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
171 c     endif
172       close(igeom)
173   180 format (I5,2F12.3,I2,$,8(1X,2I3,$))
174   190 format (3X,11(1X,2I3,$))
175   200 format (8F10.4)
176       return
177       end
178 c---------------------------------------------------------------------------
179       subroutine cartout(igr,i,etot,free,rmsd,plik)
180       implicit real*8 (a-h,o-z)
181       include 'DIMENSIONS'
182       include 'sizesclu.dat'
183       include 'COMMON.IOUNITS'
184       include 'COMMON.CHAIN'
185       include 'COMMON.VAR'
186       include 'COMMON.LOCAL'
187       include 'COMMON.INTERACT'
188       include 'COMMON.NAMES'
189       include 'COMMON.GEO'
190       include 'COMMON.CLUSTER'
191       character*80 plik
192       open (igeom,file=plik,position='append')
193       write (igeom,'(2e15.5,f10.5,$)') etot,free,rmsd
194       write (igeom,'(i4,$)')
195      &  nss_all(i),(ihpb_all(j,i),jhpb_all(j,i),j=1,nss_all(i))
196       write (igeom,'(i10)') iscore(i)
197       write (igeom,'(8f10.5)')
198      &  ((allcart(k,j,i),k=1,3),j=1,nres),
199      &  ((allcart(k,j+nres,i),k=1,3),j=nnt,nct)
200       return
201       end