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)') & '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 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') & 'SSBOND',i,'CYS',ihpb(i)-1-nres, & 'CYS',jhpb(i)-1-nres 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) if (iti.ne.10) then iatom=iatom+1 write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3) 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 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 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 write (icart,'(i4,$)') & nss,(ihpb(j),jhpb(j),j=1,nss) 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 call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) 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 call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) 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(ifile,energia) 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' include 'COMMON.ECOMPON' 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 integer ilen #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 write (istat,'("BEGIN DECOY ",a)') & pdbname(ifile)(:ilen(pdbname(ifile))) if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (istat,'("total UNRES energy",1pe15.6," rmsd ",0pf12.3, & " frac.nat. ",f12.3," frac.nnat. ",f12.3," rad.gyr",f7.2)') & energia(0),rms,frac,frac_nn,gyrate() else write (istat,'("total UNRES energy ",e15.5)') energia(0) endif write(istat,'(a10,1pe15.6)') & (ename(print_order(i)),energia(print_order(i)),i=1,nprint_ene) write (istat,'("EVDW components")') write (istat,'(5x,20(12x,a3))') (restyp(i),i=1,ntyp) do i=1,ntyp write (istat,'(a3,2x,20(1pe15.6))') restyp(i), & (vdwcompon(i,j),j=1,ntyp) enddo write (istat,'("ETOR components")') write (istat,'(5x,20(12x,a3))') (restyp(i),i=1,ntyp) do i=1,ntyp write (istat,'(a3,2x,20(1pe15.6))') restyp(i), & (torcompon(i,j),j=1,ntyp) enddo write (istat,'("ESCCOR components")') write (istat,'(5x,20(12x,a3))') (restyp(i),i=1,ntyp) do i=1,ntyp write (istat,'(a3,2x,20(1pe15.6))') restyp(i), & (sccorcompon(i,j),j=1,ntyp) enddo write (istat,'("EVDW2 components")') do i=1,ntyp write (istat,'(a3,2x,1pe15.6)') restyp(i),vdw2compon(i) enddo write (istat,'("EBE components")') do i=1,ntyp write (istat,'(a3,2x,1pe15.6)') restyp(i),becompon(i) enddo write (istat,'("ESCLOC components")') do i=1,ntyp write (istat,'(a3,2x,1pe15.6)') restyp(i),sccompon(i) enddo write (istat,'("ETORD components")') do i=1,ntyp write (istat,'(a3,2x,1pe15.6)') restyp(i),tordcompon(i) enddo write (istat,'(2a)') "END DECOY ", & pdbname(ifile)(:ilen(pdbname(ifile))) #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