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