X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_Eshel%2Fgeomout.F;fp=source%2Funres%2Fsrc_Eshel%2Fgeomout.F;h=c1ac3df4f9e714e19aab6c684d4d79c3c4afdd3b;hb=d101c97dea752458d76055fdbae49c26fff03c1f;hp=0000000000000000000000000000000000000000;hpb=325eda160c9ad2982501e091ca40606a29043712;p=unres.git diff --git a/source/unres/src_Eshel/geomout.F b/source/unres/src_Eshel/geomout.F new file mode 100644 index 0000000..c1ac3df --- /dev/null +++ b/source/unres/src_Eshel/geomout.F @@ -0,0 +1,492 @@ + 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 +