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