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(10) /'A','B','C','D','E','F','G','H','I','J'/
21 integer i,j,k,iti,itj,itk,itl,iatom,ichain,ires
23 write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
24 cmodel write (iunit,'(a5,i6)') 'MODEL',1
30 write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
32 & restyp(iti),hfrag(1,j)-1,
33 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
35 write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
37 & restyp(iti),hfrag(1,j)-1,
38 & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
48 itj=itype(bfrag(2,j)-1)
50 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
52 & restyp(iti),bfrag(1,j)-1,
53 & restyp(itj),bfrag(2,j)-2,0
55 if (bfrag(3,j).gt.bfrag(4,j)) then
58 itl=itype(bfrag(4,j)+1)
60 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
61 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
63 & restyp(itl),bfrag(4,j),
64 & restyp(itk),bfrag(3,j)-1,-1,
65 & "N",restyp(itk),bfrag(3,j)-1,
66 & "O",restyp(iti),bfrag(1,j)-1
71 itl=itype(bfrag(4,j)-1)
74 write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
75 & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
77 & restyp(itk),bfrag(3,j)-1,
78 & restyp(itl),bfrag(4,j)-2,1,
79 & "N",restyp(itk),bfrag(3,j)-1,
80 & "O",restyp(iti),bfrag(1,j)-1
92 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
93 & 'SSBOND',i,'CYS',idssb(i)-nnt+1,
94 & 'CYS',jdssb(i)-nnt+1
96 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
97 & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
98 & 'CYS',jhpb(i)-nnt+1-nres
108 if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then
111 write (iunit,'(a)') 'TER'
116 if (iti.ne.ntyp1) then
117 write (iunit,10) iatom,restyp(iti),chainid(ichain),
118 & ires,(c(j,i),j=1,3),vtot(i)
121 write (iunit,20) iatom,restyp(iti),chainid(ichain),
122 & ires,(c(j,nres+i),j=1,3),
128 write (iunit,'(a)') 'TER'
130 if (itype(i).eq.ntyp1) cycle
131 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
132 write (iunit,30) ica(i),ica(i+1)
133 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
134 write (iunit,30) ica(i),ica(i+1),ica(i)+1
135 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
136 write (iunit,30) ica(i),ica(i)+1
139 if (itype(nct).ne.10) then
140 write (iunit,30) ica(nct),ica(nct)+1
144 write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1
146 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
149 write (iunit,'(a6)') 'ENDMDL'
150 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
151 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
152 30 FORMAT ('CONECT',8I5)
155 c------------------------------------------------------------------------------
156 subroutine MOL2out(etot,tytul)
157 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
159 implicit real*8 (a-h,o-z)
161 include 'COMMON.CHAIN'
162 include 'COMMON.INTERACT'
163 include 'COMMON.NAMES'
164 include 'COMMON.IOUNITS'
165 include 'COMMON.HEADER'
166 include 'COMMON.SBRIDGE'
167 character*32 tytul,fd
169 character*6 res_num,pom,ucase
170 double precision etot
178 write (imol2,'(a)') '#'
180 & '# Creating user name: unres'
181 write (imol2,'(2a)') '# Creation time: ',
183 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
184 write (imol2,'(a)') tytul
185 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
186 write (imol2,'(a)') 'SMALL'
187 write (imol2,'(a)') 'USER_CHARGES'
188 write (imol2,'(a)') '\@<TRIPOS>ATOM'
190 write (zahl,'(i3)') i
191 pom=ucase(restyp(itype(i)))
192 res_num = pom(:3)//zahl(2:)
193 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
195 write (imol2,'(a)') '\@<TRIPOS>BOND'
197 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
200 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
202 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
204 write (zahl,'(i3)') i
205 pom = ucase(restyp(itype(i)))
206 res_num = pom(:3)//zahl(2:)
207 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
209 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
210 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
213 c------------------------------------------------------------------------
217 include 'COMMON.IOUNITS'
218 include 'COMMON.CHAIN'
220 include 'COMMON.LOCAL'
221 include 'COMMON.INTERACT'
222 include 'COMMON.NAMES'
224 include 'COMMON.TORSION'
226 write (iout,'(/a)') 'Geometry of the virtual chain.'
227 write (iout,'(7a)') ' Res ',' d',' Theta',
228 & ' Phi',' Dsc',' Alpha',' Omega'
231 write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
232 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
237 c---------------------------------------------------------------------------
238 subroutine briefout(it,ener)
241 include 'COMMON.IOUNITS'
242 include 'COMMON.CHAIN'
244 include 'COMMON.LOCAL'
245 include 'COMMON.INTERACT'
246 include 'COMMON.NAMES'
248 include 'COMMON.SBRIDGE'
250 c print '(a,i5)',intname,igeom
251 #if defined(AIX) || defined(PGI) || defined(CRAY)
252 open (igeom,file=intname,position='append')
254 open (igeom,file=intname,access='append')
257 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
259 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
260 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
262 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
263 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
264 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
265 c if (nvar.gt.nphi+ntheta) then
266 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
267 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
270 180 format (I5,F12.3,I2,9(1X,2I3))
271 190 format (3X,11(1X,2I3))
282 c----------------------------------------------------------------
284 subroutine cartout(time)
286 subroutine cartoutx(time)
290 include 'COMMON.CHAIN'
291 include 'COMMON.INTERACT'
292 include 'COMMON.NAMES'
293 include 'COMMON.IOUNITS'
294 include 'COMMON.HEADER'
295 include 'COMMON.SBRIDGE'
296 include 'COMMON.FRAG'
298 include 'COMMON.QRESTR'
300 double precision time
301 #if defined(AIX) || defined(PGI) || defined(CRAY)
302 open(icart,file=cartname,position="append")
304 open(icart,file=cartname,access="append")
306 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
308 write (icart,'(i4,$)')
309 & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
311 write (icart,'(i4,$)')
312 & nss,(ihpb(j),jhpb(j),j=1,nss)
314 write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
315 & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
316 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
317 write (icart,'(8f10.5)')
318 & ((c(k,j),k=1,3),j=1,nres),
319 & ((c(k,j+nres),k=1,3),j=nnt,nct)
323 c-----------------------------------------------------------------
325 subroutine cartout(time)
330 include 'COMMON.SETUP'
334 include 'COMMON.CHAIN'
335 include 'COMMON.INTERACT'
336 include 'COMMON.NAMES'
337 include 'COMMON.IOUNITS'
338 include 'COMMON.HEADER'
339 include 'COMMON.SBRIDGE'
340 include 'COMMON.FRAG'
342 include 'COMMON.QRESTR'
343 double precision time
345 real xcoord(3,maxres2+2),prec
349 call xdrfopen_(ixdrf,cartname, "a", iret)
350 call xdrffloat_(ixdrf, real(time), iret)
351 call xdrffloat_(ixdrf, real(potE), iret)
352 call xdrffloat_(ixdrf, real(uconst), iret)
353 call xdrffloat_(ixdrf, real(uconst_back), iret)
354 call xdrffloat_(ixdrf, real(t_bath), iret)
355 call xdrfint_(ixdrf, nss, iret)
358 call xdrfint_(ixdrf, idssb(j)+nres, iret)
359 call xdrfint_(ixdrf, jdssb(j)+nres, iret)
361 call xdrfint_(ixdrf, ihpb(j), iret)
362 call xdrfint_(ixdrf, jhpb(j), iret)
365 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
367 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
370 call xdrffloat_(ixdrf, real(qpair(i)), iret)
373 call xdrffloat_(ixdrf, real(utheta(i)), iret)
374 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
375 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
378 call xdrfopen(ixdrf,cartname, "a", iret)
379 c write (iout,*) "Writing conformation: time",time," potE",potE,
380 c & " uconst",uconst," uconst_back",uconst_back," t_bath",t_bath,
382 call xdrffloat(ixdrf, real(time), iret)
383 call xdrffloat(ixdrf, real(potE), iret)
384 call xdrffloat(ixdrf, real(uconst), iret)
385 call xdrffloat(ixdrf, real(uconst_back), iret)
386 call xdrffloat(ixdrf, real(t_bath), iret)
387 call xdrfint(ixdrf, nss, iret)
390 call xdrfint(ixdrf, idssb(j)+nres, iret)
391 call xdrfint(ixdrf, jdssb(j)+nres, iret)
393 call xdrfint(ixdrf, ihpb(j), iret)
394 call xdrfint(ixdrf, jhpb(j), iret)
397 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
399 call xdrffloat(ixdrf, real(qfrag(i)), iret)
402 call xdrffloat(ixdrf, real(qpair(i)), iret)
405 call xdrffloat(ixdrf, real(utheta(i)), iret)
406 call xdrffloat(ixdrf, real(ugamma(i)), iret)
407 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
418 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
424 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
425 call xdrfclose_(ixdrf, iret)
427 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
428 call xdrfclose(ixdrf, iret)
433 c-----------------------------------------------------------------
434 subroutine statout(itime)
435 implicit real*8 (a-h,o-z)
437 include 'COMMON.CONTROL'
438 include 'COMMON.CHAIN'
439 include 'COMMON.INTERACT'
440 include 'COMMON.NAMES'
441 include 'COMMON.IOUNITS'
442 include 'COMMON.HEADER'
443 include 'COMMON.SBRIDGE'
444 include 'COMMON.FRAG'
446 include 'COMMON.QRESTR'
447 include 'COMMON.REMD'
448 include 'COMMON.SETUP'
450 double precision energia(0:n_ene)
451 double precision gyrate
454 character*256 line1,line2
455 character*4 format1,format2
459 open(istat,file=statname,position="append")
462 #if defined(PGI) || defined(CRAY)
463 open(istat,file=statname,position="append")
465 open(istat,file=statname,access="append")
468 if (AFMlog.gt.0) then
470 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
471 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
472 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
473 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
477 C print *,'A CHUJ',potEcomp(23)
478 write (line1,'(i10,f15.2,7f12.3,i5,$)')
479 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
480 & kinetic_T,t_bath,gyrate(),
484 else if (selfguide.gt.0) then
487 distance=distance+(c(j,afmend)-c(j,afmbeg))**2
489 distance=dsqrt(distance)
491 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
492 write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
494 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
495 & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(),
496 & distance,potEcomp(23),me
500 C print *,'A CHUJ',potEcomp(23)
501 write (line1,'(i10,f15.2,8f12.3,i5,$)')
502 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
503 & kinetic_T,t_bath,gyrate(),
504 & distance,potEcomp(23),me
509 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
510 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
511 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
512 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
515 write (line1,'(i10,f15.2,7f12.3,i5,$)')
516 & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
517 & amax,kinetic_T,t_bath,gyrate(),me
521 if(usampl.and.totT.gt.eq_time) then
523 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
524 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
525 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back),
526 & ((qloc(j,i),j=1,3),i=1,nfrag_back)
527 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
530 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
531 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
532 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
533 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
540 if (print_compon) then
542 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
544 write (istat,format) "#","",
545 & (ename(print_order(i)),i=1,nprint_ene)
547 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
549 write (istat,format) line1,line2,
550 & (potEcomp(print_order(i)),i=1,nprint_ene)
552 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
553 write (istat,format) line1,line2
562 c---------------------------------------------------------------
563 double precision function gyrate()
566 include 'COMMON.INTERACT'
567 include 'COMMON.CHAIN'
569 double precision cen(3),rg
577 if (itype(i).eq.ntyp1) cycle
584 cen(j)=cen(j)/dble(ii)
588 if (itype(i).eq.ntyp1) cycle
590 rg = rg + (c(j,i)-cen(j))**2
593 gyrate = dsqrt(rg/dble(ii))