X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc-NEWSC%2Fgeomout.F;fp=source%2Fwham%2Fsrc-NEWSC%2Fgeomout.F;h=d52e23e1e8c60b2efa5f068d7aa967ad0479efc0;hb=7308760ff07636ef6b1ee28d8c3a67a23c14b34b;hp=0000000000000000000000000000000000000000;hpb=9a54ab407f6d0d9d564d52763b3e2136450b9ffc;p=unres.git diff --git a/source/wham/src-NEWSC/geomout.F b/source/wham/src-NEWSC/geomout.F new file mode 100755 index 0000000..d52e23e --- /dev/null +++ b/source/wham/src-NEWSC/geomout.F @@ -0,0 +1,167 @@ + subroutine pdbout(ii,temp,efree,etot,entropy,rmsdev) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.HEADER' + include 'COMMON.SBRIDGE' + character*50 tytul + dimension ica(maxres) + write(ipdb,'("REMARK CONF",i8," TEMPERATURE",f7.1," RMS",0pf7.2)') + & ii,temp,rmsdev + write (ipdb,'("REMARK DIMENSIONLESS FREE ENERGY",1pe15.5)') + & efree + write (ipdb,'("REMARK ENERGY",1pe15.5," ENTROPY",1pe15.5)') + & etot,entropy + iatom=0 + do i=nnt,nct + ires=i-nnt+1 + iatom=iatom+1 + ica(i)=iatom + iti=itype(i) + write (ipdb,10) iatom,restyp(iti),ires,(c(j,i),j=1,3) + if (iti.ne.10) then + iatom=iatom+1 + write (ipdb,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3) + endif + enddo + write (ipdb,'(a)') 'TER' + do i=nnt,nct-1 + if (itype(i).eq.10) then + write (ipdb,30) ica(i),ica(i+1) + else + write (ipdb,30) ica(i),ica(i+1),ica(i)+1 + endif + enddo + if (itype(nct).ne.10) then + write (ipdb,30) ica(nct),ica(nct)+1 + endif + do i=1,nss + write (ipdb,30) ica(ihpb(i))+1,ica(jhpb(i))+1 + enddo + write (ipdb,'(a)') "END" + 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3) + 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.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 'DIMENSIONS.ZSCOPT' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.HEADER' + include 'COMMON.SBRIDGE' + character*32 tytul,fd + character*3 liczba + character*6 res_num,pom,ucase +#ifdef AIX + call fdate_(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 (liczba,*) i + pom=ucase(restyp(itype(i))) + res_num = pom(:3)//liczba(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 (liczba,*) i + pom = ucase(restyp(itype(i))) + res_num = pom(:3)//liczba(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 'DIMENSIONS.ZSCOPT' + 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 ',' Dpep',' Theta', + & ' Phi',' Dsc',' Alpha',' Omega' + do i=1,nres + iti=itype(i) + write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i+1), + & 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 'DIMENSIONS.ZSCOPT' + include 'COMMON.IOUNITS' + include 'COMMON.CHAIN' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' + include 'COMMON.GEO' + include 'COMMON.SBRIDGE' + 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