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