source/cluster/wham/src-M/geomout.F

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