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
83 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
84 & 'SSBOND',i,'CYS',ihpb(i)-1-nres,
85 & 'CYS',jhpb(i)-1-nres
94 if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then
97 write (iunit,'(a)') 'TER'
102 if (iti.ne.ntyp1) then
103 write (iunit,10) iatom,restyp(iti),chainid(ichain),
104 & ires,(c(j,i),j=1,3),vtot(i)
107 write (iunit,20) iatom,restyp(iti),chainid(ichain),
108 & ires,(c(j,nres+i),j=1,3),
114 write (iunit,'(a)') 'TER'
116 if (itype(i).eq.ntyp1) cycle
117 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
118 write (iunit,30) ica(i),ica(i+1)
119 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
120 write (iunit,30) ica(i),ica(i+1),ica(i)+1
121 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
122 write (iunit,30) ica(i),ica(i)+1
125 if (itype(nct).ne.10) then
126 write (iunit,30) ica(nct),ica(nct)+1
129 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
131 write (iunit,'(a6)') 'ENDMDL'
132 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
133 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
134 30 FORMAT ('CONECT',8I5)
137 c------------------------------------------------------------------------------
138 subroutine MOL2out(etot,tytul)
139 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
141 implicit real*8 (a-h,o-z)
143 include 'COMMON.CHAIN'
144 include 'COMMON.INTERACT'
145 include 'COMMON.NAMES'
146 include 'COMMON.IOUNITS'
147 include 'COMMON.HEADER'
148 include 'COMMON.SBRIDGE'
149 character*32 tytul,fd
151 character*6 res_num,pom,ucase
159 write (imol2,'(a)') '#'
161 & '# Creating user name: unres'
162 write (imol2,'(2a)') '# Creation time: ',
164 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
165 write (imol2,'(a)') tytul
166 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
167 write (imol2,'(a)') 'SMALL'
168 write (imol2,'(a)') 'USER_CHARGES'
169 write (imol2,'(a)') '\@<TRIPOS>ATOM'
171 write (zahl,'(i3)') i
172 pom=ucase(restyp(itype(i)))
173 res_num = pom(:3)//zahl(2:)
174 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
176 write (imol2,'(a)') '\@<TRIPOS>BOND'
178 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
181 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
183 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
185 write (zahl,'(i3)') i
186 pom = ucase(restyp(itype(i)))
187 res_num = pom(:3)//zahl(2:)
188 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
190 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
191 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
194 c------------------------------------------------------------------------
196 implicit real*8 (a-h,o-z)
198 include 'COMMON.IOUNITS'
199 include 'COMMON.CHAIN'
201 include 'COMMON.LOCAL'
202 include 'COMMON.INTERACT'
203 include 'COMMON.NAMES'
205 include 'COMMON.TORSION'
206 write (iout,'(/a)') 'Geometry of the virtual chain.'
207 write (iout,'(7a)') ' Res ',' d',' Theta',
208 & ' Phi',' Dsc',' Alpha',' Omega'
211 write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
212 & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
217 c---------------------------------------------------------------------------
218 subroutine briefout(it,ener)
219 implicit real*8 (a-h,o-z)
221 include 'COMMON.IOUNITS'
222 include 'COMMON.CHAIN'
224 include 'COMMON.LOCAL'
225 include 'COMMON.INTERACT'
226 include 'COMMON.NAMES'
228 include 'COMMON.SBRIDGE'
229 c print '(a,i5)',intname,igeom
230 #if defined(AIX) || defined(PGI)
231 open (igeom,file=intname,position='append')
233 open (igeom,file=intname,access='append')
236 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
238 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
239 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
241 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
242 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
243 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
244 c if (nvar.gt.nphi+ntheta) then
245 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
246 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
249 180 format (I5,F12.3,I2,9(1X,2I3))
250 190 format (3X,11(1X,2I3))
261 c----------------------------------------------------------------
263 subroutine cartout(time)
265 subroutine cartoutx(time)
267 implicit real*8 (a-h,o-z)
269 include 'COMMON.CHAIN'
270 include 'COMMON.INTERACT'
271 include 'COMMON.NAMES'
272 include 'COMMON.IOUNITS'
273 include 'COMMON.HEADER'
274 include 'COMMON.SBRIDGE'
275 include 'COMMON.DISTFIT'
277 double precision time
278 #if defined(AIX) || defined(PGI)
279 open(icart,file=cartname,position="append")
281 open(icart,file=cartname,access="append")
283 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
284 write (icart,'(i4,$)')
285 & nss,(ihpb(j),jhpb(j),j=1,nss)
286 write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
287 & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
288 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
289 write (icart,'(8f10.5)')
290 & ((c(k,j),k=1,3),j=1,nres),
291 & ((c(k,j+nres),k=1,3),j=nnt,nct)
295 c-----------------------------------------------------------------
297 subroutine cartout(time)
298 implicit real*8 (a-h,o-z)
302 include 'COMMON.SETUP'
306 include 'COMMON.CHAIN'
307 include 'COMMON.INTERACT'
308 include 'COMMON.NAMES'
309 include 'COMMON.IOUNITS'
310 include 'COMMON.HEADER'
311 include 'COMMON.SBRIDGE'
312 include 'COMMON.DISTFIT'
314 double precision time
316 real xcoord(3,maxres2+2),prec
319 call xdrfopen_(ixdrf,cartname, "a", iret)
320 call xdrffloat_(ixdrf, real(time), iret)
321 call xdrffloat_(ixdrf, real(potE), iret)
322 call xdrffloat_(ixdrf, real(uconst), iret)
323 call xdrffloat_(ixdrf, real(uconst_back), iret)
324 call xdrffloat_(ixdrf, real(t_bath), iret)
325 call xdrfint_(ixdrf, nss, iret)
327 call xdrfint_(ixdrf, ihpb(j), iret)
328 call xdrfint_(ixdrf, jhpb(j), iret)
330 call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
332 call xdrffloat_(ixdrf, real(qfrag(i)), iret)
335 call xdrffloat_(ixdrf, real(qpair(i)), iret)
338 call xdrffloat_(ixdrf, real(utheta(i)), iret)
339 call xdrffloat_(ixdrf, real(ugamma(i)), iret)
340 call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
343 call xdrfopen(ixdrf,cartname, "a", iret)
344 call xdrffloat(ixdrf, real(time), iret)
345 call xdrffloat(ixdrf, real(potE), iret)
346 call xdrffloat(ixdrf, real(uconst), iret)
347 call xdrffloat(ixdrf, real(uconst_back), iret)
348 call xdrffloat(ixdrf, real(t_bath), iret)
349 call xdrfint(ixdrf, nss, iret)
351 call xdrfint(ixdrf, ihpb(j), iret)
352 call xdrfint(ixdrf, jhpb(j), iret)
354 call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
356 call xdrffloat(ixdrf, real(qfrag(i)), iret)
359 call xdrffloat(ixdrf, real(qpair(i)), iret)
362 call xdrffloat(ixdrf, real(utheta(i)), iret)
363 call xdrffloat(ixdrf, real(ugamma(i)), iret)
364 call xdrffloat(ixdrf, real(uscdiff(i)), iret)
375 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
381 call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
382 call xdrfclose_(ixdrf, iret)
384 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
385 call xdrfclose(ixdrf, iret)
390 c-----------------------------------------------------------------
391 subroutine statout(itime)
392 implicit real*8 (a-h,o-z)
394 include 'COMMON.CONTROL'
395 include 'COMMON.CHAIN'
396 include 'COMMON.INTERACT'
397 include 'COMMON.NAMES'
398 include 'COMMON.IOUNITS'
399 include 'COMMON.HEADER'
400 include 'COMMON.SBRIDGE'
401 include 'COMMON.DISTFIT'
403 include 'COMMON.SETUP'
405 double precision energia(0:n_ene)
406 double precision gyrate
409 character*256 line1,line2
410 character*4 format1,format2
414 open(istat,file=statname,position="append")
418 open(istat,file=statname,position="append")
420 open(istat,file=statname,access="append")
424 call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
425 write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
426 & itime,totT,EK,potE,totE,
427 & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
430 write (line1,'(i10,f15.2,7f12.3,i5,$)')
431 & itime,totT,EK,potE,totE,
432 & amax,kinetic_T,t_bath,gyrate(),me
435 if(usampl.and.totT.gt.eq_time) then
436 write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
437 & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
438 & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
439 write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
445 if (print_compon) then
446 write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
448 write (istat,format) line1,line2,
449 & (potEcomp(print_order(i)),i=1,nprint_ene)
451 write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
452 write (istat,format) line1,line2
461 c---------------------------------------------------------------
462 double precision function gyrate()
463 implicit real*8 (a-h,o-z)
465 include 'COMMON.INTERACT'
466 include 'COMMON.CHAIN'
467 double precision cen(3),rg
479 cen(j)=cen(j)/dble(nct-nnt+1)
484 rg = rg + (c(j,i)-cen(j))**2
487 gyrate = sqrt(rg/dble(nct-nnt+1))