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