source/wham/src/geomout.F

   1       subroutine pdbout(ii,temp,efree,etot,entropy,rmsdev)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'COMMON.CHAIN'
   6       include 'COMMON.INTERACT'
   7       include 'COMMON.NAMES'
   8       include 'COMMON.IOUNITS'
   9       include 'COMMON.HEADER'
  10       include 'COMMON.SBRIDGE'
  11       character*50 tytul
  12       dimension ica(maxres)
  13       write(ipdb,'("REMARK CONF",i8," TEMPERATURE",f7.1," RMS",0pf7.2)')
  14      &  ii,temp,rmsdev
  15       write (ipdb,'("REMARK DIMENSIONLESS FREE ENERGY",1pe15.5)')
  16      &  efree
  17       write (ipdb,'("REMARK ENERGY",1pe15.5," ENTROPY",1pe15.5)')
  18      &  etot,entropy
  19       iatom=0
  20       do i=nnt,nct
  21         ires=i-nnt+1
  22         iatom=iatom+1
  23         ica(i)=iatom
  24         iti=itype(i)
  25         write (ipdb,10) iatom,restyp(iti),ires,(c(j,i),j=1,3)
  26         if (iti.ne.10) then
  27           iatom=iatom+1
  28           write (ipdb,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3)
  29         endif
  30       enddo
  31       write (ipdb,'(a)') 'TER'
  32       do i=nnt,nct-1
  33         if (itype(i).eq.10) then
  34           write (ipdb,30) ica(i),ica(i+1)
  35         else
  36           write (ipdb,30) ica(i),ica(i+1),ica(i)+1
  37         endif
  38       enddo
  39       if (itype(nct).ne.10) then
  40         write (ipdb,30) ica(nct),ica(nct)+1
  41       endif
  42       do i=1,nss
  43         write (ipdb,30) ica(ihpb(i))+1,ica(jhpb(i))+1
  44       enddo
  45   10  FORMAT ('ATOM',I7,'  CA  ',A3,I6,4X,3F8.3)
  46   20  FORMAT ('ATOM',I7,'  CB  ',A3,I6,4X,3F8.3)
  47   30  FORMAT ('CONECT',8I5)
  48       return
  49       end
  50 c------------------------------------------------------------------------------
  51       subroutine MOL2out(etot,tytul)
  52 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
  53 C format.
  54       implicit real*8 (a-h,o-z)
  55       include 'DIMENSIONS'
  56       include 'DIMENSIONS.ZSCOPT'
  57       include 'COMMON.CHAIN'
  58       include 'COMMON.INTERACT'
  59       include 'COMMON.NAMES'
  60       include 'COMMON.IOUNITS'
  61       include 'COMMON.HEADER'
  62       include 'COMMON.SBRIDGE'
  63       character*32 tytul,fd
  64       character*3 liczba
  65       character*6 res_num,pom,ucase
  66 #ifdef AIX
  67       call fdate_(fd)
  68 #else
  69       call fdate(fd)
  70 #endif
  71       write (imol2,'(a)') '#'
  72       write (imol2,'(a)')
  73      & '#         Creating user name:           unres'
  74       write (imol2,'(2a)') '#         Creation time:                ',
  75      & fd
  76       write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
  77       write (imol2,'(a)') tytul
  78       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
  79       write (imol2,'(a)') 'SMALL'
  80       write (imol2,'(a)') 'USER_CHARGES'
  81       write (imol2,'(a)') '\@<TRIPOS>ATOM'
  82       do i=nnt,nct
  83         write (liczba,*) i
  84         pom=ucase(restyp(itype(i)))
  85         res_num = pom(:3)//liczba(2:)
  86         write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
  87       enddo
  88       write (imol2,'(a)') '\@<TRIPOS>BOND'
  89       do i=nnt,nct-1
  90         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
  91       enddo
  92       do i=1,nss
  93         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
  94       enddo
  95       write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
  96       do i=nnt,nct
  97         write (liczba,*) i
  98         pom = ucase(restyp(itype(i)))
  99         res_num = pom(:3)//liczba(2:)
 100         write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
 101       enddo
 102   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
 103   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
 104       return
 105       end
 106 c------------------------------------------------------------------------
 107       subroutine intout
 108       implicit real*8 (a-h,o-z)
 109       include 'DIMENSIONS'
 110       include 'DIMENSIONS.ZSCOPT'
 111       include 'COMMON.IOUNITS'
 112       include 'COMMON.CHAIN'
 113       include 'COMMON.VAR'
 114       include 'COMMON.LOCAL'
 115       include 'COMMON.INTERACT'
 116       include 'COMMON.NAMES'
 117       include 'COMMON.GEO'
 118       write (iout,'(/a)') 'Geometry of the virtual chain.'
 119       write (iout,'(7a)') '  Res  ','      Dpep','     Theta',
 120      & '       Phi','       Dsc','     Alpha','      Omega'
 121       do i=1,nres
 122         iti=itype(i)
 123         write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i+1),
 124      &     rad2deg*theta(i),
 125      &     rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),rad2deg*omeg(i)
 126       enddo
 127       return
 128       end
 129 c---------------------------------------------------------------------------
 130       subroutine briefout(it,ener)
 131       implicit real*8 (a-h,o-z)
 132       include 'DIMENSIONS'
 133       include 'DIMENSIONS.ZSCOPT'
 134       include 'COMMON.IOUNITS'
 135       include 'COMMON.CHAIN'
 136       include 'COMMON.VAR'
 137       include 'COMMON.LOCAL'
 138       include 'COMMON.INTERACT'
 139       include 'COMMON.NAMES'
 140       include 'COMMON.GEO'
 141       include 'COMMON.SBRIDGE'
 142       print '(a,i5)',intname,igeom
 143 #if defined(AIX) || defined(PGI)
 144       open (igeom,file=intname,position='append')
 145 #else
 146       open (igeom,file=intname,access='append')
 147 #endif
 148       IF (NSS.LE.9) THEN
 149         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 150       ELSE
 151         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
 152         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
 153       ENDIF
 154 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 155       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 156       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 157 c     if (nvar.gt.nphi+ntheta) then
 158         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 159         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 160 c     endif
 161       close(igeom)
 162   180 format (I5,F12.3,I2,9(1X,2I3))
 163   190 format (3X,11(1X,2I3))
 164   200 format (8F10.4)
 165       return
 166       end