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'
13 character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
15 write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
16 cmodel write (iunit,'(a5,i6)') 'MODEL',1
22 write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
24 & restyp(iti),hfrag(1,j)-1,
25 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
27 write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
29 & restyp(iti),hfrag(1,j)-1,
30 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
40 itj=itype(bfrag(2,j)-1)
42 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
44 & restyp(iti),bfrag(1,j)-1,
45 & restyp(itj),bfrag(2,j)-2,0
47 if (bfrag(3,j).gt.bfrag(4,j)) then
50 itl=itype(bfrag(4,j)+1)
52 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
53 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
55 & restyp(itl),bfrag(4,j),
56 & restyp(itk),bfrag(3,j)-1,-1,
57 & "N",restyp(itk),bfrag(3,j)-1,
58 & "O",restyp(iti),bfrag(1,j)-1
63 itl=itype(bfrag(4,j)-1)
66 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
67 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
69 & restyp(itk),bfrag(3,j)-1,
70 & restyp(itl),bfrag(4,j)-2,1,
71 & "N",restyp(itk),bfrag(3,j)-1,
72 & "O",restyp(iti),bfrag(1,j)-1
83 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
84 & 'SSBOND',i,'CYS',ihpb(i)-1-nres,
85 & 'CYS',jhpb(i)-1-nres
94 if (iti.eq.ntyp1) then
97 write (iunit,'(a)') 'TER'
102 write (iunit,10) iatom,restyp(iti),chainid(ichain),
103 & ires,(c(j,i),j=1,3),vtot(i)
106 write (iunit,20) iatom,restyp(iti),chainid(ichain),
107 & ires,(c(j,nres+i),j=1,3),
112 write (iunit,'(a)') 'TER'
114 if (itype(i).eq.ntyp1) cycle
115 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
116 write (iunit,30) ica(i),ica(i+1)
117 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
118 write (iunit,30) ica(i),ica(i+1),ica(i)+1
119 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
120 write (iunit,30) ica(i),ica(i)+1
123 if (itype(nct).ne.10) then
124 write (iunit,30) ica(nct),ica(nct)+1
127 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
129 write (iunit,'(a6)') 'ENDMDL'
130 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
131 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
132 30 FORMAT ('CONECT',8I5)
135 c------------------------------------------------------------------------------
136 subroutine MOL2out(etot,tytul)
137 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
139 implicit real*8 (a-h,o-z)
141 include 'COMMON.CHAIN'
142 include 'COMMON.INTERACT'
143 include 'COMMON.NAMES'
144 include 'COMMON.IOUNITS'
145 include 'COMMON.HEADER'
146 include 'COMMON.SBRIDGE'
147 character*32 tytul,fd
149 character*6 res_num,pom,ucase
157 write (imol2,'(a)') '#'
159 & '# Creating user name: unres'
160 write (imol2,'(2a)') '# Creation time: ',
162 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
163 write (imol2,'(a)') tytul
164 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
165 write (imol2,'(a)') 'SMALL'
166 write (imol2,'(a)') 'USER_CHARGES'
167 write (imol2,'(a)') '\@<TRIPOS>ATOM'
169 write (zahl,'(i3)') i
170 pom=ucase(restyp(itype(i)))
171 res_num = pom(:3)//zahl(2:)
172 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
174 write (imol2,'(a)') '\@<TRIPOS>BOND'
176 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
179 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
181 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
183 write (zahl,'(i3)') i
184 pom = ucase(restyp(itype(i)))
185 res_num = pom(:3)//zahl(2:)
186 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
188 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
189 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
192 c------------------------------------------------------------------------
194 implicit real*8 (a-h,o-z)
196 include 'COMMON.IOUNITS'
197 include 'COMMON.CHAIN'
199 include 'COMMON.LOCAL'
200 include 'COMMON.INTERACT'
201 include 'COMMON.NAMES'
203 include 'COMMON.TORSION'
204 write (iout,'(/a)') 'Geometry of the virtual chain.'
205 write (iout,'(7a)') ' Res ',' d',' Theta',
206 & ' Phi',' Dsc',' Alpha',' Omega'
209 write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
210 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
215 c---------------------------------------------------------------------------
216 subroutine briefout(it,ener)
217 implicit real*8 (a-h,o-z)
219 include 'COMMON.IOUNITS'
220 include 'COMMON.CHAIN'
222 include 'COMMON.LOCAL'
223 include 'COMMON.INTERACT'
224 include 'COMMON.NAMES'
226 include 'COMMON.SBRIDGE'
227 c print '(a,i5)',intname,igeom
228 #if defined(AIX) || defined(PGI)
229 open (igeom,file=intname,position='append')
231 open (igeom,file=intname,access='append')
234 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
236 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
237 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
239 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
240 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
241 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
242 c if (nvar.gt.nphi+ntheta) then
243 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
244 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
247 180 format (I5,F12.3,I2,9(1X,2I3))
248 190 format (3X,11(1X,2I3))
259 c----------------------------------------------------------------
261 subroutine cartout(time)
263 subroutine cartoutx(time)
265 implicit real*8 (a-h,o-z)
267 include 'COMMON.CHAIN'
268 include 'COMMON.INTERACT'
269 include 'COMMON.NAMES'
270 include 'COMMON.IOUNITS'
271 include 'COMMON.HEADER'
272 include 'COMMON.SBRIDGE'
273 include 'COMMON.DISTFIT'
275 double precision time
276 #if defined(AIX) || defined(PGI)
277 open(icart,file=cartname,position="append")
279 open(icart,file=cartname,access="append")
281 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
282 write (icart,'(i4,$)')
283 & nss,(ihpb(j),jhpb(j),j=1,nss)
284 write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
285 & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
286 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
287 write (icart,'(8f10.5)')
288 & ((c(k,j),k=1,3),j=1,nres),
289 & ((c(k,j+nres),k=1,3),j=nnt,nct)
293 c-----------------------------------------------------------------
295 subroutine cartout(time)
296 implicit real*8 (a-h,o-z)
300 include 'COMMON.SETUP'
304 include 'COMMON.CHAIN'
305 include 'COMMON.INTERACT'
306 include 'COMMON.NAMES'
307 include 'COMMON.IOUNITS'
308 include 'COMMON.HEADER'
309 include 'COMMON.SBRIDGE'
310 include 'COMMON.DISTFIT'
312 double precision time
314 real xcoord(3,maxres2+2),prec
317 call xdrfopen_(ixdrf,cartname, "a", iret)
318 call xdrffloat_(ixdrf, real(time), iret)
319 call xdrffloat_(ixdrf, real(potE), iret)
320 call xdrffloat_(ixdrf, real(uconst), iret)
321 call xdrffloat_(ixdrf, real(uconst_back), iret)
322 call xdrffloat_(ixdrf, real(t_bath), iret)
323 call xdrfint_(ixdrf, nss, iret)
325 call xdrfint_(ixdrf, ihpb(j), iret)
326 call xdrfint_(ixdrf, jhpb(j), iret)
328 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
330 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
333 call xdrffloat_(ixdrf, real(qpair(i)), iret)
336 call xdrffloat_(ixdrf, real(utheta(i)), iret)
337 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
338 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
341 call xdrfopen(ixdrf,cartname, "a", iret)
342 call xdrffloat(ixdrf, real(time), iret)
343 call xdrffloat(ixdrf, real(potE), iret)
344 call xdrffloat(ixdrf, real(uconst), iret)
345 call xdrffloat(ixdrf, real(uconst_back), iret)
346 call xdrffloat(ixdrf, real(t_bath), iret)
347 call xdrfint(ixdrf, nss, iret)
349 call xdrfint(ixdrf, ihpb(j), iret)
350 call xdrfint(ixdrf, jhpb(j), iret)
352 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
354 call xdrffloat(ixdrf, real(qfrag(i)), iret)
357 call xdrffloat(ixdrf, real(qpair(i)), iret)
360 call xdrffloat(ixdrf, real(utheta(i)), iret)
361 call xdrffloat(ixdrf, real(ugamma(i)), iret)
362 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
373 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
379 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
380 call xdrfclose_(ixdrf, iret)
382 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
383 call xdrfclose(ixdrf, iret)
388 c-----------------------------------------------------------------
389 subroutine statout(itime)
390 implicit real*8 (a-h,o-z)
392 include 'COMMON.CONTROL'
393 include 'COMMON.CHAIN'
394 include 'COMMON.INTERACT'
395 include 'COMMON.NAMES'
396 include 'COMMON.IOUNITS'
397 include 'COMMON.HEADER'
398 include 'COMMON.SBRIDGE'
399 include 'COMMON.DISTFIT'
401 include 'COMMON.SETUP'
403 double precision energia(0:n_ene)
404 double precision gyrate
407 character*256 line1,line2
408 character*4 format1,format2
412 open(istat,file=statname,position="append")
416 open(istat,file=statname,position="append")
418 open(istat,file=statname,access="append")
422 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
423 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
424 & itime,totT,EK,potE,totE,
425 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
428 write (line1,'(i10,f15.2,7f12.3,i5,$)')
429 & itime,totT,EK,potE,totE,
430 & amax,kinetic_T,t_bath,gyrate(),me
433 if(usampl.and.totT.gt.eq_time) then
434 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
435 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
436 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
437 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
443 if (print_compon) then
444 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
446 write (istat,format) line1,line2,
447 & (potEcomp(print_order(i)),i=1,nprint_ene)
449 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
450 write (istat,format) line1,line2
459 c---------------------------------------------------------------
460 double precision function gyrate()
461 implicit real*8 (a-h,o-z)
463 include 'COMMON.INTERACT'
464 include 'COMMON.CHAIN'
465 double precision cen(3),rg
477 cen(j)=cen(j)/dble(nct-nnt+1)
482 rg = rg + (c(j,i)-cen(j))**2
485 gyrate = sqrt(rg/dble(nct-nnt+1))