1 subroutine pdbout(etot,tytul,iunit)
5 include 'COMMON.INTERACT'
7 include 'COMMON.IOUNITS'
8 include 'COMMON.HEADER'
9 include 'COMMON.SBRIDGE'
13 include 'COMMON.LAGRANGE.5diag'
15 include 'COMMON.LAGRANGE'
19 character*1 chainid(52) /'A','B','C','D','E','F','G','H','I','J',
20 & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
21 & 'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p',
22 & 'q','r','s','t','u','v','w','x','y','z'/
24 integer i,j,k,iti,itj,itk,itl,iatom,ichain,ires
26 write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
27 cmodel write (iunit,'(a5,i6)') 'MODEL',1
33 write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
35 & restyp(iti),hfrag(1,j)-1,
36 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
38 write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
40 & restyp(iti),hfrag(1,j)-1,
41 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
51 itj=itype(bfrag(2,j)-1)
53 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
55 & restyp(iti),bfrag(1,j)-1,
56 & restyp(itj),bfrag(2,j)-2,0
58 if (bfrag(3,j).gt.bfrag(4,j)) then
61 itl=itype(bfrag(4,j)+1)
63 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
64 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
66 & restyp(itl),bfrag(4,j),
67 & restyp(itk),bfrag(3,j)-1,-1,
68 & "N",restyp(itk),bfrag(3,j)-1,
69 & "O",restyp(iti),bfrag(1,j)-1
74 itl=itype(bfrag(4,j)-1)
77 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
78 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
80 & restyp(itk),bfrag(3,j)-1,
81 & restyp(itl),bfrag(4,j)-2,1,
82 & "N",restyp(itk),bfrag(3,j)-1,
83 & "O",restyp(iti),bfrag(1,j)-1
95 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
96 & 'SSBOND',i,'CYS',iss(idssb(i))-nnt+1,
97 & 'CYS',iss(jdssb(i))-nnt+1
99 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
100 & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
101 & 'CYS',jhpb(i)-nnt+1-nres
111 if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then
113 if (ichain.gt.52) ichain=1
115 write (iunit,'(a)') 'TER'
116 else if (iti.ne.ntyp1) then
120 if (iti.ne.ntyp1) then
121 write (iunit,10) iatom,restyp(iti),chainid(ichain),
122 & ires,(c(j,i),j=1,3),vtot(i)
125 write (iunit,20) iatom,restyp(iti),chainid(ichain),
126 & ires,(c(j,nres+i),j=1,3),
132 write (iunit,'(a)') 'TER'
134 if (itype(i).eq.ntyp1) cycle
135 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
136 write (iunit,30) ica(i),ica(i+1)
137 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
138 write (iunit,30) ica(i),ica(i+1),ica(i)+1
139 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
140 write (iunit,30) ica(i),ica(i)+1
143 if (itype(nct).ne.10) then
144 write (iunit,30) ica(nct),ica(nct)+1
148 write (iunit,30) ica(iss(idssb(i)))+1,ica(iss(jdssb(i)))+1
150 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
153 write (iunit,'(a6)') 'ENDMDL'
154 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
155 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
156 30 FORMAT ('CONECT',8I5)
159 c------------------------------------------------------------------------------
160 subroutine MOL2out(etot,tytul)
161 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
163 implicit real*8 (a-h,o-z)
165 include 'COMMON.CHAIN'
166 include 'COMMON.INTERACT'
167 include 'COMMON.NAMES'
168 include 'COMMON.IOUNITS'
169 include 'COMMON.HEADER'
170 include 'COMMON.SBRIDGE'
171 character*32 tytul,fd
173 character*6 res_num,pom,ucase
174 double precision etot
182 write (imol2,'(a)') '#'
184 & '# Creating user name: unres'
185 write (imol2,'(2a)') '# Creation time: ',
187 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
188 write (imol2,'(a)') tytul
189 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
190 write (imol2,'(a)') 'SMALL'
191 write (imol2,'(a)') 'USER_CHARGES'
192 write (imol2,'(a)') '\@<TRIPOS>ATOM'
194 write (zahl,'(i3)') i
195 pom=ucase(restyp(itype(i)))
196 res_num = pom(:3)//zahl(2:)
197 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
199 write (imol2,'(a)') '\@<TRIPOS>BOND'
201 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
204 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
206 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
208 write (zahl,'(i3)') i
209 pom = ucase(restyp(itype(i)))
210 res_num = pom(:3)//zahl(2:)
211 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
213 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
214 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
217 c------------------------------------------------------------------------
221 include 'COMMON.IOUNITS'
222 include 'COMMON.CHAIN'
224 include 'COMMON.LOCAL'
225 include 'COMMON.INTERACT'
226 include 'COMMON.NAMES'
228 include 'COMMON.TORSION'
230 write (iout,'(/a)') 'Geometry of the virtual chain.'
231 write (iout,'(7a)') ' Res ',' d',' Theta',
232 & ' Phi',' Dsc',' Alpha',' Omega'
235 write (iout,'(a3,i5,6f10.3)') restyp(iti),i,vbld(i),
236 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
241 c---------------------------------------------------------------------------
242 subroutine briefout(it,ener)
245 include 'COMMON.IOUNITS'
246 include 'COMMON.CHAIN'
248 include 'COMMON.LOCAL'
249 include 'COMMON.INTERACT'
250 include 'COMMON.NAMES'
252 include 'COMMON.SBRIDGE'
254 c print '(a,i5)',intname,igeom
255 #if defined(AIX) || defined(PGI) || defined(CRAY)
256 open (igeom,file=intname,position='append')
258 open (igeom,file=intname,access='append')
261 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
263 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
264 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
266 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
267 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
268 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
269 c if (nvar.gt.nphi+ntheta) then
270 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
271 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
274 180 format (I5,F12.3,I2,9(1X,2I3))
275 190 format (3X,11(1X,2I3))
286 c----------------------------------------------------------------
288 subroutine cartout(time)
290 subroutine cartoutx(time)
294 include 'COMMON.CHAIN'
295 include 'COMMON.INTERACT'
296 include 'COMMON.NAMES'
297 include 'COMMON.IOUNITS'
298 include 'COMMON.HEADER'
299 include 'COMMON.SBRIDGE'
300 include 'COMMON.FRAG'
302 include 'COMMON.QRESTR'
304 double precision time
305 #if defined(AIX) || defined(PGI) || defined(CRAY)
306 open(icart,file=cartname,position="append")
308 open(icart,file=cartname,access="append")
310 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
312 write (icart,'(i4,$)')
313 & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
315 write (icart,'(i4,$)')
316 & nss,(ihpb(j),jhpb(j),j=1,nss)
318 write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
319 & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
320 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
321 write (icart,'(8f10.5)')
322 & ((c(k,j),k=1,3),j=1,nres),
323 & ((c(k,j+nres),k=1,3),j=nnt,nct)
327 c-----------------------------------------------------------------
329 subroutine cartout(time)
334 include 'COMMON.SETUP'
338 include 'COMMON.CONTROL'
339 include 'COMMON.CHAIN'
340 include 'COMMON.INTERACT'
341 include 'COMMON.NAMES'
342 include 'COMMON.IOUNITS'
343 include 'COMMON.HEADER'
344 include 'COMMON.SBRIDGE'
345 include 'COMMON.FRAG'
347 include 'COMMON.QRESTR'
348 double precision time
350 real xcoord(3,maxres2+2),prec
354 call xdrfopen_(ixdrf,cartname, "a", iret)
355 call xdrffloat_(ixdrf, real(time), iret)
356 call xdrffloat_(ixdrf, real(potE), iret)
357 call xdrffloat_(ixdrf, real(uconst), iret)
358 call xdrffloat_(ixdrf, real(uconst_back), iret)
359 call xdrffloat_(ixdrf, real(t_bath), iret)
360 call xdrfint_(ixdrf, nss, iret)
363 if (modecalc.eq.14) then
364 call xdrfint_(ixdrf, idssb(j), iret)
365 call xdrfint_(ixdrf, jdssb(j), iret)
367 call xdrfint_(ixdrf, iss(idssb(j))+nres, iret)
368 call xdrfint_(ixdrf, iss(jdssb(j))+nres, iret)
371 call xdrfint_(ixdrf, ihpb(j), iret)
372 call xdrfint_(ixdrf, jhpb(j), iret)
375 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
377 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
380 call xdrffloat_(ixdrf, real(qpair(i)), iret)
383 call xdrffloat_(ixdrf, real(utheta(i)), iret)
384 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
385 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
388 call xdrfopen(ixdrf,cartname, "a", iret)
389 c write (iout,*) "Writing conformation: time",time," potE",potE,
390 c & " uconst",uconst," uconst_back",uconst_back," t_bath",t_bath,
392 call xdrffloat(ixdrf, real(time), iret)
393 call xdrffloat(ixdrf, real(potE), iret)
394 call xdrffloat(ixdrf, real(uconst), iret)
395 call xdrffloat(ixdrf, real(uconst_back), iret)
396 call xdrffloat(ixdrf, real(t_bath), iret)
397 call xdrfint(ixdrf, nss, iret)
400 if (modecalc.eq.14) then
401 call xdrfint(ixdrf, idssb(j), iret)
402 call xdrfint(ixdrf, jdssb(j), iret)
404 call xdrfint(ixdrf, iss(idssb(j))+nres, iret)
405 call xdrfint(ixdrf, iss(jdssb(j))+nres, iret)
408 call xdrfint(ixdrf, ihpb(j), iret)
409 call xdrfint(ixdrf, jhpb(j), iret)
412 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
414 call xdrffloat(ixdrf, real(qfrag(i)), iret)
417 call xdrffloat(ixdrf, real(qpair(i)), iret)
420 call xdrffloat(ixdrf, real(utheta(i)), iret)
421 call xdrffloat(ixdrf, real(ugamma(i)), iret)
422 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
433 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
439 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
440 call xdrfclose_(ixdrf, iret)
442 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
443 call xdrfclose(ixdrf, iret)
448 c-----------------------------------------------------------------
449 subroutine statout(itime)
450 implicit real*8 (a-h,o-z)
452 include 'COMMON.CONTROL'
453 include 'COMMON.CHAIN'
454 include 'COMMON.INTERACT'
455 include 'COMMON.NAMES'
456 include 'COMMON.IOUNITS'
457 include 'COMMON.HEADER'
458 include 'COMMON.SBRIDGE'
459 include 'COMMON.FRAG'
461 include 'COMMON.QRESTR'
462 include 'COMMON.REMD'
463 include 'COMMON.SETUP'
465 double precision energia(0:n_ene)
466 double precision gyrate
469 character*256 line1,line2
470 character*4 format1,format2
474 open(istat,file=statname,position="append")
477 #if defined(PGI) || defined(CRAY)
478 open(istat,file=statname,position="append")
480 open(istat,file=statname,access="append")
483 if (AFMlog.gt.0) then
485 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
486 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
487 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
488 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
492 C print *,'A CHUJ',potEcomp(23)
493 write (line1,'(i10,f15.2,7f12.3,i5,$)')
494 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
495 & kinetic_T,t_bath,gyrate(),
499 else if (selfguide.gt.0) then
502 distance=distance+(c(j,afmend)-c(j,afmbeg))**2
504 distance=dsqrt(distance)
506 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
507 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
509 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
510 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
511 & distance,potEcomp(23),me
515 C print *,'A CHUJ',potEcomp(23)
516 write (line1,'(i10,f15.2,8f12.3,i5,$)')
517 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
518 & kinetic_T,t_bath,gyrate(),
519 & distance,potEcomp(23),me
524 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
525 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
526 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
527 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
530 write (line1,'(i10,f15.2,7f12.3,i5,$)')
531 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
532 & amax,kinetic_T,t_bath,gyrate(),me
536 if(usampl.and.totT.gt.eq_time) then
538 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
539 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
540 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back),
541 & ((qloc(j,i),j=1,3),i=1,nfrag_back)
542 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
545 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
546 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
547 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
548 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
555 if (print_compon) then
557 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
559 write (istat,format) "#"," ",
560 & (ename(print_order(i)),i=1,nprint_ene)
562 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
564 write (istat,format) line1,line2,
565 & (potEcomp(print_order(i)),i=1,nprint_ene)
567 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
568 write (istat,format) line1,line2
577 c---------------------------------------------------------------
578 double precision function gyrate()
581 include 'COMMON.INTERACT'
582 include 'COMMON.CHAIN'
584 double precision cen(3),rg
592 if (itype(i).eq.ntyp1) cycle
599 cen(j)=cen(j)/dble(ii)
603 if (itype(i).eq.ntyp1) cycle
605 rg = rg + (c(j,i)-cen(j))**2
608 gyrate = dsqrt(rg/dble(ii))