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