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(idssb(i))+1,ica(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',8I7)
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.CHAIN'
339 include 'COMMON.INTERACT'
340 include 'COMMON.NAMES'
341 include 'COMMON.IOUNITS'
342 include 'COMMON.HEADER'
343 include 'COMMON.SBRIDGE'
344 include 'COMMON.FRAG'
346 include 'COMMON.QRESTR'
347 double precision time
349 real xcoord(3,maxres2+2),prec
353 call xdrfopen_(ixdrf,cartname, "a", iret)
354 call xdrffloat_(ixdrf, real(time), iret)
355 call xdrffloat_(ixdrf, real(potE), iret)
356 call xdrffloat_(ixdrf, real(uconst), iret)
357 call xdrffloat_(ixdrf, real(uconst_back), iret)
358 call xdrffloat_(ixdrf, real(t_bath), iret)
359 call xdrfint_(ixdrf, nss, iret)
362 call xdrfint_(ixdrf, idssb(j)+nres, iret)
363 call xdrfint_(ixdrf, jdssb(j)+nres, iret)
365 call xdrfint_(ixdrf, ihpb(j), iret)
366 call xdrfint_(ixdrf, jhpb(j), iret)
369 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
371 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
374 call xdrffloat_(ixdrf, real(qpair(i)), iret)
377 call xdrffloat_(ixdrf, real(utheta(i)), iret)
378 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
379 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
382 call xdrfopen(ixdrf,cartname, "a", iret)
383 c write (iout,*) "Writing conformation: time",time," potE",potE,
384 c & " uconst",uconst," uconst_back",uconst_back," t_bath",t_bath,
386 call xdrffloat(ixdrf, real(time), iret)
387 call xdrffloat(ixdrf, real(potE), iret)
388 call xdrffloat(ixdrf, real(uconst), iret)
389 call xdrffloat(ixdrf, real(uconst_back), iret)
390 call xdrffloat(ixdrf, real(t_bath), iret)
391 call xdrfint(ixdrf, nss, iret)
394 call xdrfint(ixdrf, idssb(j)+nres, iret)
395 call xdrfint(ixdrf, jdssb(j)+nres, iret)
397 call xdrfint(ixdrf, ihpb(j), iret)
398 call xdrfint(ixdrf, jhpb(j), iret)
401 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
403 call xdrffloat(ixdrf, real(qfrag(i)), iret)
406 call xdrffloat(ixdrf, real(qpair(i)), iret)
409 call xdrffloat(ixdrf, real(utheta(i)), iret)
410 call xdrffloat(ixdrf, real(ugamma(i)), iret)
411 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
422 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
428 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
429 call xdrfclose_(ixdrf, iret)
431 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
432 call xdrfclose(ixdrf, iret)
437 c-----------------------------------------------------------------
438 subroutine statout(itime)
439 implicit real*8 (a-h,o-z)
441 include 'COMMON.CONTROL'
442 include 'COMMON.CHAIN'
443 include 'COMMON.INTERACT'
444 include 'COMMON.NAMES'
445 include 'COMMON.IOUNITS'
446 include 'COMMON.HEADER'
447 include 'COMMON.SBRIDGE'
448 include 'COMMON.FRAG'
450 include 'COMMON.QRESTR'
451 include 'COMMON.REMD'
452 include 'COMMON.SETUP'
454 double precision energia(0:n_ene)
455 double precision gyrate
458 character*256 line1,line2
459 character*4 format1,format2
463 open(istat,file=statname,position="append")
466 #if defined(PGI) || defined(CRAY)
467 open(istat,file=statname,position="append")
469 open(istat,file=statname,access="append")
472 if (AFMlog.gt.0) then
474 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
475 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
476 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
477 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
481 C print *,'A CHUJ',potEcomp(23)
482 write (line1,'(i10,f15.2,7f12.3,i5,$)')
483 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
484 & kinetic_T,t_bath,gyrate(),
488 else if (selfguide.gt.0) then
491 distance=distance+(c(j,afmend)-c(j,afmbeg))**2
493 distance=dsqrt(distance)
495 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
496 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
498 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
499 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
500 & distance,potEcomp(23),me
504 C print *,'A CHUJ',potEcomp(23)
505 write (line1,'(i10,f15.2,8f12.3,i5,$)')
506 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
507 & kinetic_T,t_bath,gyrate(),
508 & distance,potEcomp(23),me
513 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
514 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
515 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
516 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
519 write (line1,'(i10,f15.2,7f12.3,i5,$)')
520 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
521 & amax,kinetic_T,t_bath,gyrate(),me
525 if(usampl.and.totT.gt.eq_time) then
527 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
528 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
529 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back),
530 & ((qloc(j,i),j=1,3),i=1,nfrag_back)
531 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
534 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
535 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
536 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
537 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
544 if (print_compon) then
546 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
548 write (istat,format) "#"," ",
549 & (ename(print_order(i)),i=1,nprint_ene)
551 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
553 write (istat,format) line1,line2,
554 & (potEcomp(print_order(i)),i=1,nprint_ene)
556 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
557 write (istat,format) line1,line2
566 c---------------------------------------------------------------
567 double precision function gyrate()
570 include 'COMMON.INTERACT'
571 include 'COMMON.CHAIN'
573 double precision cen(3),rg
581 if (itype(i).eq.ntyp1) cycle
588 cen(j)=cen(j)/dble(ii)
592 if (itype(i).eq.ntyp1) cycle
594 rg = rg + (c(j,i)-cen(j))**2
597 gyrate = dsqrt(rg/dble(ii))