1 subroutine pdbout(etot,tytul,iunit)
2 implicit real*8 (a-h,o-z)
5 include 'COMMON.INTERACT'
7 include 'COMMON.IOUNITS'
8 include 'COMMON.HEADER'
9 include 'COMMON.SBRIDGE'
10 include 'COMMON.DISTFIT'
14 write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
15 cmodel write (iunit,'(a5,i6)') 'MODEL',1
21 write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
23 & restyp(iti),hfrag(1,j)-1,
24 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
26 write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
28 & restyp(iti),hfrag(1,j)-1,
29 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
39 itj=itype(bfrag(2,j)-1)
41 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
43 & restyp(iti),bfrag(1,j)-1,
44 & restyp(itj),bfrag(2,j)-2,0
46 if (bfrag(3,j).gt.bfrag(4,j)) then
49 itl=itype(bfrag(4,j)+1)
51 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
52 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
54 & restyp(itl),bfrag(4,j),
55 & restyp(itk),bfrag(3,j)-1,-1,
56 & "N",restyp(itk),bfrag(3,j)-1,
57 & "O",restyp(iti),bfrag(1,j)-1
62 itl=itype(bfrag(4,j)-1)
65 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
66 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
68 & restyp(itk),bfrag(3,j)-1,
69 & restyp(itl),bfrag(4,j)-2,1,
70 & "N",restyp(itk),bfrag(3,j)-1,
71 & "O",restyp(iti),bfrag(1,j)-1
82 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
83 & 'SSBOND',i,'CYS',ihpb(i)-1-nres,
84 & 'CYS',jhpb(i)-1-nres
94 write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i)
97 write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3),
101 write (iunit,'(a)') 'TER'
103 if (itype(i).eq.10) then
104 write (iunit,30) ica(i),ica(i+1)
106 write (iunit,30) ica(i),ica(i+1),ica(i)+1
109 if (itype(nct).ne.10) then
110 write (iunit,30) ica(nct),ica(nct)+1
113 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
115 write (iunit,'(a6)') 'ENDMDL'
116 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3)
117 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3)
118 30 FORMAT ('CONECT',8I5)
121 c------------------------------------------------------------------------------
122 subroutine MOL2out(etot,tytul)
123 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
125 implicit real*8 (a-h,o-z)
127 include 'COMMON.CHAIN'
128 include 'COMMON.INTERACT'
129 include 'COMMON.NAMES'
130 include 'COMMON.IOUNITS'
131 include 'COMMON.HEADER'
132 include 'COMMON.SBRIDGE'
133 character*50 tytul,fd
135 character*6 res_num,pom,ucase
143 write (imol2,'(a)') '#'
145 & '# Creating user name: unres'
146 write (imol2,'(2a)') '# Creation time: ',
148 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
149 write (imol2,'(a)') tytul
150 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
151 write (imol2,'(a)') 'SMALL'
152 write (imol2,'(a)') 'USER_CHARGES'
153 write (imol2,'(a)') '\@<TRIPOS>ATOM'
155 write (zahl,'(i3)') i
156 pom=ucase(restyp(itype(i)))
157 res_num = pom(:3)//zahl(2:)
158 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
160 write (imol2,'(a)') '\@<TRIPOS>BOND'
162 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
165 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
167 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
169 write (zahl,'(i3)') i
170 pom = ucase(restyp(itype(i)))
171 res_num = pom(:3)//zahl(2:)
172 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
174 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
175 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
178 c------------------------------------------------------------------------
180 implicit real*8 (a-h,o-z)
182 include 'COMMON.IOUNITS'
183 include 'COMMON.CHAIN'
185 include 'COMMON.LOCAL'
186 include 'COMMON.INTERACT'
187 include 'COMMON.NAMES'
189 write (iout,'(/a)') 'Geometry of the virtual chain.'
190 write (iout,'(7a)') ' Res ',' d',' Theta',
191 & ' Gamma',' Dsc',' Alpha',' Beta '
194 write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
195 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
200 c---------------------------------------------------------------------------
201 subroutine briefout(it,ener)
202 implicit real*8 (a-h,o-z)
204 include 'COMMON.IOUNITS'
205 include 'COMMON.CHAIN'
207 include 'COMMON.LOCAL'
208 include 'COMMON.INTERACT'
209 include 'COMMON.NAMES'
211 include 'COMMON.SBRIDGE'
212 c print '(a,i5)',intname,igeom
213 #if defined(AIX) || defined(PGI)
214 open (igeom,file=intname,position='append')
216 open (igeom,file=intname,access='append')
219 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
221 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
222 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
224 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
225 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
226 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
227 c if (nvar.gt.nphi+ntheta) then
228 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
229 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
232 180 format (I5,F12.3,I2,9(1X,2I3))
233 190 format (3X,11(1X,2I3))
244 c-----------------------------------------------------------------
245 subroutine statout(itime)
246 implicit real*8 (a-h,o-z)
248 include 'COMMON.CONTROL'
249 include 'COMMON.CHAIN'
250 include 'COMMON.INTERACT'
251 include 'COMMON.NAMES'
252 include 'COMMON.IOUNITS'
253 include 'COMMON.HEADER'
254 include 'COMMON.SBRIDGE'
255 include 'COMMON.DISTFIT'
257 c include 'COMMON.REMD'
258 include 'COMMON.SETUP'
260 double precision energia(0:n_ene)
261 double precision gyrate
264 character*256 line1,line2
265 character*4 format1,format2
269 open(istat,file=statname,position="append")
273 open(istat,file=statname,position="append")
275 open(istat,file=statname,access="append")
279 c call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
280 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
281 & itime,totT,EK,potE,totE,
282 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
285 write (line1,'(i10,f15.2,7f12.3,i5,$)')
286 & itime,totT,EK,potE,totE,
287 & amax,kinetic_T,t_bath,gyrate(),me
290 if(usampl.and.totT.gt.eq_time) then
291 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
292 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
293 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
294 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
296 elseif(hremd.gt.0) then
297 write(line2,'(i5)') iset
303 if (print_compon) then
304 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
306 write (istat,format) line1,line2,
307 & (potEcomp(print_order(i)),i=1,nprint_ene)
309 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
310 write (istat,format) line1,line2
319 c---------------------------------------------------------------
320 double precision function gyrate()
321 implicit real*8 (a-h,o-z)
323 include 'COMMON.INTERACT'
324 include 'COMMON.CHAIN'
325 double precision cen(3),rg
337 cen(j)=cen(j)/dble(nct-nnt+1)
342 rg = rg + (c(j,i)-cen(j))**2
345 gyrate = sqrt(rg/dble(nct-nnt+1))