subroutine pdbout(etot,tytul,iunit) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.MD' character*50 tytul dimension ica(maxres) write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot cmodel write (iunit,'(a5,i6)') 'MODEL',1 if (nhfrag.gt.0) then do j=1,nhfrag iti=itype(hfrag(1,j)) itj=itype(hfrag(2,j)) if (j.lt.10) then write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)') & 'HELIX',j,'H',j, & restyp(iti),hfrag(1,j)-1, & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) else write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3,t76,i5)') & 'HELIX',j,'H',j, & restyp(iti),hfrag(1,j)-1, & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) endif enddo endif if (nbfrag.gt.0) then do j=1,nbfrag iti=itype(bfrag(1,j)) itj=itype(bfrag(2,j)-1) write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)') & 'SHEET',1,'B',j,2, & restyp(iti),bfrag(1,j)-1, & restyp(itj),bfrag(2,j)-2,0 if (bfrag(3,j).gt.bfrag(4,j)) then itk=itype(bfrag(3,j)) itl=itype(bfrag(4,j)+1) write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') & 'SHEET',2,'B',j,2, & restyp(itl),bfrag(4,j), & restyp(itk),bfrag(3,j)-1,-1, & "N",restyp(itk),bfrag(3,j)-1, & "O",restyp(iti),bfrag(1,j)-1 else itk=itype(bfrag(3,j)) itl=itype(bfrag(4,j)-1) write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') & 'SHEET',2,'B',j,2, & restyp(itk),bfrag(3,j)-1, & restyp(itl),bfrag(4,j)-2,1, & "N",restyp(itk),bfrag(3,j)-1, & "O",restyp(iti),bfrag(1,j)-1 endif enddo endif if (nss.gt.0) then do i=1,nss if (dyn_ss) then write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') & 'SSBOND',i,'CYS',idssb(i)-nnt+1, & 'CYS',jdssb(i)-nnt+1 else write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, & 'CYS',jhpb(i)-nnt+1-nres endif enddo endif iatom=0 do i=nnt,nct ires=i-nnt+1 iatom=iatom+1 ica(i)=iatom iti=itype(i) write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i) if (iti.ne.10) then iatom=iatom+1 write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3), & vtot(i+nres) endif enddo write (iunit,'(a)') 'TER' do i=nnt,nct-1 if (itype(i).eq.10) then write (iunit,30) ica(i),ica(i+1) else write (iunit,30) ica(i),ica(i+1),ica(i)+1 endif enddo if (itype(nct).ne.10) then write (iunit,30) ica(nct),ica(nct)+1 endif do i=1,nss if (dyn_ss) then write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 else write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 endif enddo write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3) 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3) 30 FORMAT ('CONECT',8I5) return end c------------------------------------------------------------------------------ subroutine MOL2out(etot,tytul) C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 C format. implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' character*32 tytul,fd character*3 zahl character*6 res_num,pom,ucase #ifdef AIX call fdate_(fd) #elif (defined CRAY) call date(fd) #else call fdate(fd) #endif write (imol2,'(a)') '#' write (imol2,'(a)') & '# Creating user name: unres' write (imol2,'(2a)') '# Creation time: ', & fd write (imol2,'(/a)') '\@MOLECULE' write (imol2,'(a)') tytul write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0 write (imol2,'(a)') 'SMALL' write (imol2,'(a)') 'USER_CHARGES' write (imol2,'(a)') '\@ATOM' do i=nnt,nct write (zahl,'(i3)') i pom=ucase(restyp(itype(i))) res_num = pom(:3)//zahl(2:) write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0 enddo write (imol2,'(a)') '\@BOND' do i=nnt,nct-1 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 enddo do i=1,nss write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 enddo write (imol2,'(a)') '\@SUBSTRUCTURE' do i=nnt,nct write (zahl,'(i3)') i pom = ucase(restyp(itype(i))) res_num = pom(:3)//zahl(2:) write (imol2,30) i-nnt+1,res_num,i-nnt+1,0 enddo 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****') 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****') return end c------------------------------------------------------------------------ subroutine intout implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' write (iout,'(/a)') 'Geometry of the virtual chain.' write (iout,'(7a)') ' Res ',' d',' Theta', & ' Gamma',' Dsc',' Alpha',' Beta ' do i=1,nres iti=itype(i) write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i), & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), & rad2deg*omeg(i) enddo return end c--------------------------------------------------------------------------- subroutine briefout(it,ener) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' include 'COMMON.SBRIDGE' c print '(a,i5)',intname,igeom #if defined(AIX) || defined(PGI) open (igeom,file=intname,position='append') #else open (igeom,file=intname,access='append') #endif IF (NSS.LE.9) THEN WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS) ELSE WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9) WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) ENDIF c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES) c if (nvar.gt.nphi+ntheta) then write (igeom,200) (rad2deg*alph(i),i=2,nres-1) write (igeom,200) (rad2deg*omeg(i),i=2,nres-1) c endif close(igeom) 180 format (I5,F12.3,I2,9(1X,2I3)) 190 format (3X,11(1X,2I3)) 200 format (8F10.4) return end #ifdef WINIFL subroutine fdate(fd) character*32 fd write(fd,'(32x)') return end #endif c---------------------------------------------------------------- #ifdef NOXDR subroutine cartout(time) #else subroutine cartoutx(time) #endif implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.MD' double precision time #if defined(AIX) || defined(PGI) open(icart,file=cartname,position="append") #else open(icart,file=cartname,access="append") #endif write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath if (dyn_ss) then write (icart,'(i4,$)') & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) else write (icart,'(i4,$)') & nss,(ihpb(j),jhpb(j),j=1,nss) endif write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) write (icart,'(8f10.5)') & ((c(k,j),k=1,3),j=1,nres), & ((c(k,j+nres),k=1,3),j=nnt,nct) close(icart) return end c----------------------------------------------------------------- #ifndef NOXDR subroutine cartout(time) implicit real*8 (a-h,o-z) include 'DIMENSIONS' #ifdef MPI include 'mpif.h' include 'COMMON.SETUP' #else parameter (me=0) #endif include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.MD' double precision time integer iret,itmp real xcoord(3,maxres2+2),prec #ifdef AIX call xdrfopen_(ixdrf,cartname, "a", iret) call xdrffloat_(ixdrf, real(time), iret) call xdrffloat_(ixdrf, real(potE), iret) call xdrffloat_(ixdrf, real(uconst), iret) call xdrffloat_(ixdrf, real(uconst_back), iret) call xdrffloat_(ixdrf, real(t_bath), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then call xdrfint_(ixdrf, idssb(j)+nres, iret) call xdrfint_(ixdrf, jdssb(j)+nres, iret) else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) endif enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag call xdrffloat_(ixdrf, real(qfrag(i)), iret) enddo do i=1,npair call xdrffloat_(ixdrf, real(qpair(i)), iret) enddo do i=1,nfrag_back call xdrffloat_(ixdrf, real(utheta(i)), iret) call xdrffloat_(ixdrf, real(ugamma(i)), iret) call xdrffloat_(ixdrf, real(uscdiff(i)), iret) enddo #else call xdrfopen(ixdrf,cartname, "a", iret) call xdrffloat(ixdrf, real(time), iret) call xdrffloat(ixdrf, real(potE), iret) call xdrffloat(ixdrf, real(uconst), iret) call xdrffloat(ixdrf, real(uconst_back), iret) call xdrffloat(ixdrf, real(t_bath), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then call xdrfint(ixdrf, idssb(j)+nres, iret) call xdrfint(ixdrf, jdssb(j)+nres, iret) else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag call xdrffloat(ixdrf, real(qfrag(i)), iret) enddo do i=1,npair call xdrffloat(ixdrf, real(qpair(i)), iret) enddo do i=1,nfrag_back call xdrffloat(ixdrf, real(utheta(i)), iret) call xdrffloat(ixdrf, real(ugamma(i)), iret) call xdrffloat(ixdrf, real(uscdiff(i)), iret) enddo #endif prec=10000.0 do i=1,nres do j=1,3 xcoord(j,i)=c(j,i) enddo enddo do i=nnt,nct do j=1,3 xcoord(j,nres+i-nnt+1)=c(j,i+nres) enddo enddo itmp=nres+nct-nnt+1 #ifdef AIX call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) call xdrfclose_(ixdrf, iret) #else call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) call xdrfclose(ixdrf, iret) #endif return end #endif c----------------------------------------------------------------- subroutine statout(itime) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.MD' include 'COMMON.REMD' include 'COMMON.SETUP' integer itime double precision energia(0:n_ene) double precision gyrate external gyrate common /gucio/ cm character*256 line1,line2 character*4 format1,format2 character*30 format #ifdef AIX if(itime.eq.0) then open(istat,file=statname,position="append") endif #else #ifdef PGI open(istat,file=statname,position="append") #else open(istat,file=statname,access="append") #endif #endif if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) if(tnp .or. tnp1 .or. tnh) then write (line1,'(i10,f15.2,3f12.3,f12.6,f7.2,4f6.3,3f12.3,i5,$)') & itime,totT,EK,potE,totE,hhh, & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me format1="a145" else write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') & itime,totT,EK,potE,totE, & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me format1="a133" endif else if(tnp .or. tnp1 .or. tnh) then write (line1,'(i10,f15.2,7f12.3,f12.6,i5,$)') & itime,totT,EK,potE,totE,hhh, & amax,kinetic_T,t_bath,gyrate(),me format1="a126" else write (line1,'(i10,f15.2,7f12.3,i5,$)') & itime,totT,EK,potE,totE, & amax,kinetic_T,t_bath,gyrate(),me format1="a114" endif endif if(usampl.and.totT.gt.eq_time) then write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair & +21*nfrag_back elseif(hremd.gt.0) then write(line2,'(i5)') iset format2="a005" else format2="a001" line2=' ' endif if (print_compon) then if(itime.eq.0) then write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",20a12)" write (istat,format) "#","", & (ename(print_order(i)),i=1,nprint_ene) endif write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",20f12.3)" write (istat,format) line1,line2, & (potEcomp(print_order(i)),i=1,nprint_ene) else write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")" write (istat,format) line1,line2 endif #if defined(AIX) call flush(istat) #else close(istat) #endif return end c--------------------------------------------------------------- double precision function gyrate() implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.INTERACT' include 'COMMON.CHAIN' double precision cen(3),rg do j=1,3 cen(j)=0.0d0 enddo do i=nnt,nct do j=1,3 cen(j)=cen(j)+c(j,i) enddo enddo do j=1,3 cen(j)=cen(j)/dble(nct-nnt+1) enddo rg = 0.0d0 do i = nnt, nct do j=1,3 rg = rg + (c(j,i)-cen(j))**2 enddo end do gyrate = sqrt(rg/dble(nct-nnt+1)) return end