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