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
84 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
85 & 'SSBOND',i,'CYS',idssb(i)-nnt+1,
86 & 'CYS',jdssb(i)-nnt+1
88 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
89 & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
90 & 'CYS',jhpb(i)-nnt+1-nres
103 write (iunit,'(a)') 'TER'
108 write (iunit,10) iatom,restyp(iti),chainid(ichain),
109 & ires,(c(j,i),j=1,3),vtot(i)
112 write (iunit,20) iatom,restyp(iti),chainid(ichain),
113 & ires,(c(j,nres+i),j=1,3),
118 write (iunit,'(a)') 'TER'
120 if (itype(i).eq.21) cycle
121 if (itype(i).eq.10 .and. itype(i+1).ne.21) then
122 write (iunit,30) ica(i),ica(i+1)
123 else if (itype(i).ne.10 .and. itype(i+1).ne.21) then
124 write (iunit,30) ica(i),ica(i+1),ica(i)+1
125 else if (itype(i).ne.10 .and. itype(i+1).eq.21) then
126 write (iunit,30) ica(i),ica(i)+1
129 if (itype(nct).ne.10) then
130 write (iunit,30) ica(nct),ica(nct)+1
134 write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1
136 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
139 write (iunit,'(a6)') 'ENDMDL'
140 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
141 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
142 30 FORMAT ('CONECT',8I5)
145 c------------------------------------------------------------------------------
146 subroutine MOL2out(etot,tytul)
147 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
149 implicit real*8 (a-h,o-z)
151 include 'COMMON.CHAIN'
152 include 'COMMON.INTERACT'
153 include 'COMMON.NAMES'
154 include 'COMMON.IOUNITS'
155 include 'COMMON.HEADER'
156 include 'COMMON.SBRIDGE'
157 character*32 tytul,fd
159 character*6 res_num,pom,ucase
167 write (imol2,'(a)') '#'
169 & '# Creating user name: unres'
170 write (imol2,'(2a)') '# Creation time: ',
172 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
173 write (imol2,'(a)') tytul
174 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
175 write (imol2,'(a)') 'SMALL'
176 write (imol2,'(a)') 'USER_CHARGES'
177 write (imol2,'(a)') '\@<TRIPOS>ATOM'
179 write (zahl,'(i3)') i
180 pom=ucase(restyp(itype(i)))
181 res_num = pom(:3)//zahl(2:)
182 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
184 write (imol2,'(a)') '\@<TRIPOS>BOND'
186 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
189 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
191 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
193 write (zahl,'(i3)') i
194 pom = ucase(restyp(itype(i)))
195 res_num = pom(:3)//zahl(2:)
196 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
198 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
199 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
202 c------------------------------------------------------------------------
204 implicit real*8 (a-h,o-z)
206 include 'COMMON.IOUNITS'
207 include 'COMMON.CHAIN'
209 include 'COMMON.LOCAL'
210 include 'COMMON.INTERACT'
211 include 'COMMON.NAMES'
213 write (iout,'(/a)') 'Geometry of the virtual chain.'
214 write (iout,'(7a)') ' Res ',' d',' Theta',
215 & ' Phi',' Dsc',' Alpha',' Omega'
218 write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
219 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
224 c---------------------------------------------------------------------------
225 subroutine briefout(it,ener)
226 implicit real*8 (a-h,o-z)
228 include 'COMMON.IOUNITS'
229 include 'COMMON.CHAIN'
231 include 'COMMON.LOCAL'
232 include 'COMMON.INTERACT'
233 include 'COMMON.NAMES'
235 include 'COMMON.SBRIDGE'
236 c print '(a,i5)',intname,igeom
237 #if defined(AIX) || defined(PGI)
238 open (igeom,file=intname,position='append')
240 open (igeom,file=intname,access='append')
243 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
245 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
246 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
248 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
249 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
250 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
251 c if (nvar.gt.nphi+ntheta) then
252 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
253 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
256 180 format (I5,F12.3,I2,9(1X,2I3))
257 190 format (3X,11(1X,2I3))
268 c----------------------------------------------------------------
270 subroutine cartout(time)
272 subroutine cartoutx(time)
274 implicit real*8 (a-h,o-z)
276 include 'COMMON.CHAIN'
277 include 'COMMON.INTERACT'
278 include 'COMMON.NAMES'
279 include 'COMMON.IOUNITS'
280 include 'COMMON.HEADER'
281 include 'COMMON.SBRIDGE'
282 include 'COMMON.DISTFIT'
284 double precision time
285 #if defined(AIX) || defined(PGI)
286 open(icart,file=cartname,position="append")
288 open(icart,file=cartname,access="append")
290 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
292 write (icart,'(i4,$)')
293 & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
295 write (icart,'(i4,$)')
296 & nss,(ihpb(j),jhpb(j),j=1,nss)
298 write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
299 & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
300 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
301 write (icart,'(8f10.5)')
302 & ((c(k,j),k=1,3),j=1,nres),
303 & ((c(k,j+nres),k=1,3),j=nnt,nct)
307 c-----------------------------------------------------------------
309 subroutine cartout(time)
310 implicit real*8 (a-h,o-z)
314 include 'COMMON.SETUP'
318 include 'COMMON.CHAIN'
319 include 'COMMON.INTERACT'
320 include 'COMMON.NAMES'
321 include 'COMMON.IOUNITS'
322 include 'COMMON.HEADER'
323 include 'COMMON.SBRIDGE'
324 include 'COMMON.DISTFIT'
326 double precision time
328 real xcoord(3,maxres2+2),prec
331 call xdrfopen_(ixdrf,cartname, "a", iret)
332 call xdrffloat_(ixdrf, real(time), iret)
333 call xdrffloat_(ixdrf, real(potE), iret)
334 call xdrffloat_(ixdrf, real(uconst), iret)
335 call xdrffloat_(ixdrf, real(uconst_back), iret)
336 call xdrffloat_(ixdrf, real(t_bath), iret)
337 call xdrfint_(ixdrf, nss, iret)
340 call xdrfint_(ixdrf, idssb(j)+nres, iret)
341 call xdrfint_(ixdrf, jdssb(j)+nres, iret)
343 call xdrfint_(ixdrf, ihpb(j), iret)
344 call xdrfint_(ixdrf, jhpb(j), iret)
347 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
349 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
352 call xdrffloat_(ixdrf, real(qpair(i)), iret)
355 call xdrffloat_(ixdrf, real(utheta(i)), iret)
356 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
357 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
360 call xdrfopen(ixdrf,cartname, "a", iret)
361 call xdrffloat(ixdrf, real(time), iret)
362 call xdrffloat(ixdrf, real(potE), iret)
363 call xdrffloat(ixdrf, real(uconst), iret)
364 call xdrffloat(ixdrf, real(uconst_back), iret)
365 call xdrffloat(ixdrf, real(t_bath), iret)
366 call xdrfint(ixdrf, nss, iret)
369 call xdrfint(ixdrf, idssb(j)+nres, iret)
370 call xdrfint(ixdrf, jdssb(j)+nres, iret)
372 call xdrfint(ixdrf, ihpb(j), iret)
373 call xdrfint(ixdrf, jhpb(j), iret)
376 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
378 call xdrffloat(ixdrf, real(qfrag(i)), iret)
381 call xdrffloat(ixdrf, real(qpair(i)), iret)
384 call xdrffloat(ixdrf, real(utheta(i)), iret)
385 call xdrffloat(ixdrf, real(ugamma(i)), iret)
386 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
397 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
403 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
404 call xdrfclose_(ixdrf, iret)
406 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
407 call xdrfclose(ixdrf, iret)
412 c-----------------------------------------------------------------
413 subroutine statout(itime)
414 implicit real*8 (a-h,o-z)
416 include 'COMMON.CONTROL'
417 include 'COMMON.CHAIN'
418 include 'COMMON.INTERACT'
419 include 'COMMON.NAMES'
420 include 'COMMON.IOUNITS'
421 include 'COMMON.HEADER'
422 include 'COMMON.SBRIDGE'
423 include 'COMMON.DISTFIT'
425 include 'COMMON.SETUP'
427 double precision energia(0:n_ene)
428 double precision gyrate
431 character*256 line1,line2
432 character*4 format1,format2
436 open(istat,file=statname,position="append")
440 open(istat,file=statname,position="append")
442 open(istat,file=statname,access="append")
446 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
447 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
448 & itime,totT,EK,potE,totE,
449 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
452 write (line1,'(i10,f15.2,7f12.3,i5,$)')
453 & itime,totT,EK,potE,totE,
454 & amax,kinetic_T,t_bath,gyrate(),me
457 if(usampl.and.totT.gt.eq_time) then
458 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
459 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
460 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
461 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
467 if (print_compon) then
468 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
470 write (istat,format) line1,line2,
471 & (potEcomp(print_order(i)),i=1,nprint_ene)
473 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
474 write (istat,format) line1,line2
483 c---------------------------------------------------------------
484 double precision function gyrate()
485 implicit real*8 (a-h,o-z)
487 include 'COMMON.INTERACT'
488 include 'COMMON.CHAIN'
489 double precision cen(3),rg
501 cen(j)=cen(j)/dble(nct-nnt+1)
506 rg = rg + (c(j,i)-cen(j))**2
509 gyrate = sqrt(rg/dble(nct-nnt+1))