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