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'
12 include 'COMMON.LAGRANGE'
14 character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
16 write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
17 cmodel write (iunit,'(a5,i6)') 'MODEL',1
23 write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
25 & restyp(iti),hfrag(1,j)-1,
26 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
28 write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
30 & restyp(iti),hfrag(1,j)-1,
31 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
41 itj=itype(bfrag(2,j)-1)
43 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
45 & restyp(iti),bfrag(1,j)-1,
46 & restyp(itj),bfrag(2,j)-2,0
48 if (bfrag(3,j).gt.bfrag(4,j)) then
51 itl=itype(bfrag(4,j)+1)
53 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
54 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
56 & restyp(itl),bfrag(4,j),
57 & restyp(itk),bfrag(3,j)-1,-1,
58 & "N",restyp(itk),bfrag(3,j)-1,
59 & "O",restyp(iti),bfrag(1,j)-1
64 itl=itype(bfrag(4,j)-1)
67 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
68 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
70 & restyp(itk),bfrag(3,j)-1,
71 & restyp(itl),bfrag(4,j)-2,1,
72 & "N",restyp(itk),bfrag(3,j)-1,
73 & "O",restyp(iti),bfrag(1,j)-1
85 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
86 & 'SSBOND',i,'CYS',idssb(i)-nnt+1,
87 & 'CYS',jdssb(i)-nnt+1
89 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
90 & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
91 & 'CYS',jhpb(i)-nnt+1-nres
101 if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then
104 write (iunit,'(a)') 'TER'
109 if (iti.ne.ntyp1) then
110 write (iunit,10) iatom,restyp(iti),chainid(ichain),
111 & ires,(c(j,i),j=1,3),vtot(i)
114 write (iunit,20) iatom,restyp(iti),chainid(ichain),
115 & ires,(c(j,nres+i),j=1,3),
121 write (iunit,'(a)') 'TER'
123 if (itype(i).eq.ntyp1) cycle
124 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
125 write (iunit,30) ica(i),ica(i+1)
126 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
127 write (iunit,30) ica(i),ica(i+1),ica(i)+1
128 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
129 write (iunit,30) ica(i),ica(i)+1
132 if (itype(nct).ne.10) then
133 write (iunit,30) ica(nct),ica(nct)+1
137 write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1
139 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
142 write (iunit,'(a6)') 'ENDMDL'
143 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
144 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
145 30 FORMAT ('CONECT',8I5)
148 c------------------------------------------------------------------------------
149 subroutine MOL2out(etot,tytul)
150 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
152 implicit real*8 (a-h,o-z)
154 include 'COMMON.CHAIN'
155 include 'COMMON.INTERACT'
156 include 'COMMON.NAMES'
157 include 'COMMON.IOUNITS'
158 include 'COMMON.HEADER'
159 include 'COMMON.SBRIDGE'
160 character*32 tytul,fd
162 character*6 res_num,pom,ucase
170 write (imol2,'(a)') '#'
172 & '# Creating user name: unres'
173 write (imol2,'(2a)') '# Creation time: ',
175 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
176 write (imol2,'(a)') tytul
177 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
178 write (imol2,'(a)') 'SMALL'
179 write (imol2,'(a)') 'USER_CHARGES'
180 write (imol2,'(a)') '\@<TRIPOS>ATOM'
182 write (zahl,'(i3)') i
183 pom=ucase(restyp(itype(i)))
184 res_num = pom(:3)//zahl(2:)
185 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
187 write (imol2,'(a)') '\@<TRIPOS>BOND'
189 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
192 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
194 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
196 write (zahl,'(i3)') i
197 pom = ucase(restyp(itype(i)))
198 res_num = pom(:3)//zahl(2:)
199 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
201 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
202 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
205 c------------------------------------------------------------------------
207 implicit real*8 (a-h,o-z)
209 include 'COMMON.IOUNITS'
210 include 'COMMON.CHAIN'
212 include 'COMMON.LOCAL'
213 include 'COMMON.INTERACT'
214 include 'COMMON.NAMES'
216 include 'COMMON.TORSION'
217 write (iout,'(/a)') 'Geometry of the virtual chain.'
218 write (iout,'(7a)') ' Res ',' d',' Theta',
219 & ' Phi',' Dsc',' Alpha',' Omega'
222 write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
223 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
228 c---------------------------------------------------------------------------
229 subroutine briefout(it,ener)
230 implicit real*8 (a-h,o-z)
232 include 'COMMON.IOUNITS'
233 include 'COMMON.CHAIN'
235 include 'COMMON.LOCAL'
236 include 'COMMON.INTERACT'
237 include 'COMMON.NAMES'
239 include 'COMMON.SBRIDGE'
240 c print '(a,i5)',intname,igeom
241 #if defined(AIX) || defined(PGI) || defined(CRAY)
242 open (igeom,file=intname,position='append')
244 open (igeom,file=intname,access='append')
247 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
249 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
250 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
252 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
253 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
254 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
255 c if (nvar.gt.nphi+ntheta) then
256 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
257 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
260 180 format (I5,F12.3,I2,9(1X,2I3))
261 190 format (3X,11(1X,2I3))
272 c----------------------------------------------------------------
274 subroutine cartout(time)
276 subroutine cartoutx(time)
278 implicit real*8 (a-h,o-z)
280 include 'COMMON.CHAIN'
281 include 'COMMON.INTERACT'
282 include 'COMMON.NAMES'
283 include 'COMMON.IOUNITS'
284 include 'COMMON.HEADER'
285 include 'COMMON.SBRIDGE'
286 include 'COMMON.DISTFIT'
288 include 'COMMON.QRESTR'
289 double precision time
290 #if defined(AIX) || defined(PGI) || defined(CRAY)
291 open(icart,file=cartname,position="append")
293 open(icart,file=cartname,access="append")
295 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
297 write (icart,'(i4,$)')
298 & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
300 write (icart,'(i4,$)')
301 & nss,(ihpb(j),jhpb(j),j=1,nss)
303 write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
304 & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
305 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
306 write (icart,'(8f10.5)')
307 & ((c(k,j),k=1,3),j=1,nres),
308 & ((c(k,j+nres),k=1,3),j=nnt,nct)
312 c-----------------------------------------------------------------
314 subroutine cartout(time)
315 implicit real*8 (a-h,o-z)
319 include 'COMMON.SETUP'
323 include 'COMMON.CHAIN'
324 include 'COMMON.INTERACT'
325 include 'COMMON.NAMES'
326 include 'COMMON.IOUNITS'
327 include 'COMMON.HEADER'
328 include 'COMMON.SBRIDGE'
329 include 'COMMON.DISTFIT'
331 include 'COMMON.QRESTR'
332 double precision time
334 real xcoord(3,maxres2+2),prec
337 call xdrfopen_(ixdrf,cartname, "a", iret)
338 call xdrffloat_(ixdrf, real(time), iret)
339 call xdrffloat_(ixdrf, real(potE), iret)
340 call xdrffloat_(ixdrf, real(uconst), iret)
341 call xdrffloat_(ixdrf, real(uconst_back), iret)
342 call xdrffloat_(ixdrf, real(t_bath), iret)
343 call xdrfint_(ixdrf, nss, iret)
346 call xdrfint_(ixdrf, idssb(j)+nres, iret)
347 call xdrfint_(ixdrf, jdssb(j)+nres, iret)
349 call xdrfint_(ixdrf, ihpb(j), iret)
350 call xdrfint_(ixdrf, jhpb(j), iret)
353 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
355 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
358 call xdrffloat_(ixdrf, real(qpair(i)), iret)
361 call xdrffloat_(ixdrf, real(utheta(i)), iret)
362 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
363 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
366 call xdrfopen(ixdrf,cartname, "a", iret)
367 c write (iout,*) "Writing conformation: time",time," potE",potE,
368 c & " uconst",uconst," uconst_back",uconst_back," t_bath",t_bath,
370 call xdrffloat(ixdrf, real(time), iret)
371 call xdrffloat(ixdrf, real(potE), iret)
372 call xdrffloat(ixdrf, real(uconst), iret)
373 call xdrffloat(ixdrf, real(uconst_back), iret)
374 call xdrffloat(ixdrf, real(t_bath), iret)
375 call xdrfint(ixdrf, nss, iret)
378 call xdrfint(ixdrf, idssb(j)+nres, iret)
379 call xdrfint(ixdrf, jdssb(j)+nres, iret)
381 call xdrfint(ixdrf, ihpb(j), iret)
382 call xdrfint(ixdrf, jhpb(j), iret)
385 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
387 call xdrffloat(ixdrf, real(qfrag(i)), iret)
390 call xdrffloat(ixdrf, real(qpair(i)), iret)
393 call xdrffloat(ixdrf, real(utheta(i)), iret)
394 call xdrffloat(ixdrf, real(ugamma(i)), iret)
395 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
406 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
412 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
413 call xdrfclose_(ixdrf, iret)
415 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
416 call xdrfclose(ixdrf, iret)
421 c-----------------------------------------------------------------
422 subroutine statout(itime)
423 implicit real*8 (a-h,o-z)
425 include 'COMMON.CONTROL'
426 include 'COMMON.CHAIN'
427 include 'COMMON.INTERACT'
428 include 'COMMON.NAMES'
429 include 'COMMON.IOUNITS'
430 include 'COMMON.HEADER'
431 include 'COMMON.SBRIDGE'
432 include 'COMMON.DISTFIT'
434 include 'COMMON.QRESTR'
435 include 'COMMON.REMD'
436 include 'COMMON.SETUP'
438 double precision energia(0:n_ene)
439 double precision gyrate
442 character*256 line1,line2
443 character*4 format1,format2
447 open(istat,file=statname,position="append")
450 #if defined(PGI) || defined(CRAY)
451 open(istat,file=statname,position="append")
453 open(istat,file=statname,access="append")
456 if (AFMlog.gt.0) then
458 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
459 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
460 & itime,totT,EK,potE,totE,
461 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
465 C print *,'A CHUJ',potEcomp(23)
466 write (line1,'(i10,f15.2,7f12.3,i5,$)')
467 & itime,totT,EK,potE,totE,
468 & kinetic_T,t_bath,gyrate(),
472 else if (selfguide.gt.0) then
475 distance=distance+(c(j,afmend)-c(j,afmbeg))**2
477 distance=dsqrt(distance)
479 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
480 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
482 & itime,totT,EK,potE,totE,
483 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
484 & distance,potEcomp(23),me
488 C print *,'A CHUJ',potEcomp(23)
489 write (line1,'(i10,f15.2,8f12.3,i5,$)')
490 & itime,totT,EK,potE,totE,
491 & kinetic_T,t_bath,gyrate(),
492 & distance,potEcomp(23),me
497 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
498 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
499 & itime,totT,EK,potE,totE,
500 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
503 write (line1,'(i10,f15.2,7f12.3,i5,$)')
504 & itime,totT,EK,potE,totE,
505 & amax,kinetic_T,t_bath,gyrate(),me
509 if(usampl.and.totT.gt.eq_time) then
511 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
512 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
513 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back),
514 & ((qloc(j,i),j=1,3),i=1,nfrag_back)
515 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
518 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
519 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
520 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
521 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
528 if (print_compon) then
530 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
532 write (istat,format) "#","",
533 & (ename(print_order(i)),i=1,nprint_ene)
535 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
537 write (istat,format) line1,line2,
538 & (potEcomp(print_order(i)),i=1,nprint_ene)
540 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
541 write (istat,format) line1,line2
550 c---------------------------------------------------------------
551 double precision function gyrate()
552 implicit real*8 (a-h,o-z)
554 include 'COMMON.INTERACT'
555 include 'COMMON.CHAIN'
556 double precision cen(3),rg
564 if (itype(i).eq.ntyp1) cycle
571 cen(j)=cen(j)/dble(ii)
575 if (itype(i).eq.ntyp1) cycle
577 rg = rg + (c(j,i)-cen(j))**2
580 gyrate = dsqrt(rg/dble(ii))