source/cluster/wham/src-HCD-5D/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       iti_prev=0
  21       do i=nnt,nct
  22         iti=itype(i)
  23         if (iti.eq.ntyp1) then
  24           ires=0
  25           if (iti_prev.ne.ntyp1) then
  26             write (ipdb,'(a)') 'TER'
  27             ichain=ichain+1
  28           endif
  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),1.0d0,tempfac(1,i)
  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),1.0d0,tempfac(2,i)
  39         endif
  40         endif
  41         iti_prev=iti
  42       enddo
  43       write (ipdb,'(a)') 'TER'
  44       do i=nnt,nct-1
  45         if (itype(i).eq.ntyp1) cycle
  46         if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
  47           write (ipdb,30) ica(i),ica(i+1)
  48         else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
  49           write (ipdb,30) ica(i),ica(i+1),ica(i)+1
  50         else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
  51           write (ipdb,30) ica(i),ica(i)+1
  52         endif
  53       enddo
  54       if (itype(nct).ne.10) then
  55         write (ipdb,30) ica(nct),ica(nct)+1
  56       endif
  57       do i=1,nss
  58         write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
  59       enddo
  60       write (ipdb,'(a6)') 'ENDMDL'
  61   10  FORMAT ('ATOM',I7,'  CA  ',A3,1X,A1,I4,4X,3F8.3,2f6.2)
  62   20  FORMAT ('ATOM',I7,'  CB  ',A3,1X,A1,I4,4X,3F8.3,2f6.2)
  63   30  FORMAT ('CONECT',8I5)
  64       return
  65       end
  66 c------------------------------------------------------------------------------
  67       subroutine MOL2out(etot,tytul)
  68 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
  69 C format.
  70       implicit real*8 (a-h,o-z)
  71       include 'DIMENSIONS'
  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*4 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,nct-nnt+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 c        write (liczba,*) i
  99         pom=ucase(restyp(itype(i)))
 100 c        res_num = pom(:3)//liczba(2:)
 101         write (imol2,10) i-nnt+1,(c(j,i),j=1,3),i-nnt+1,pom,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,'(i4)') i
 113         pom = ucase(restyp(itype(i)))
 114 c        res_num = pom(:3)//liczba(2:)
 115         write (imol2,30) i-nnt+1,pom,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 'COMMON.IOUNITS'
 126       include 'COMMON.CHAIN'
 127       include 'COMMON.VAR'
 128       include 'COMMON.LOCAL'
 129       include 'COMMON.INTERACT'
 130       include 'COMMON.NAMES'
 131       include 'COMMON.GEO'
 132       write (iout,'(/a)') 'Geometry of the virtual chain.'
 133       write (iout,'(6a)') '  Res  ','     Theta','       Phi',
 134      & '       Dsc','     Alpha','      Omega'
 135       do i=1,nres
 136         iti=itype(i)
 137         write (iout,'(a3,i4,5f10.3)') restyp(iti),i,rad2deg*theta(i),
 138      &     rad2deg*phi(i),dsc(iti),rad2deg*alph(i),rad2deg*omeg(i)
 139       enddo
 140       return
 141       end
 142 c---------------------------------------------------------------------------
 143       subroutine briefout(it,klasa,ener,free,nss,ihpb,jhpb,plik)
 144       implicit real*8 (a-h,o-z)
 145       include 'DIMENSIONS'
 146       include 'COMMON.IOUNITS'
 147       include 'COMMON.CHAIN'
 148       include 'COMMON.VAR'
 149       include 'COMMON.LOCAL'
 150       include 'COMMON.INTERACT'
 151       include 'COMMON.NAMES'
 152       include 'COMMON.GEO'
 153       dimension ihpb(maxss),jhpb(maxss)
 154       character*80 plik
 155 c     print '(a,i5)',intname,igeom
 156 #ifdef AIX
 157       open (igeom,file=plik,position='append')
 158 #else
 159       open (igeom,file=plik,position='append')
 160 #endif
 161       IF (NSS.LT.9) THEN
 162         WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 163       ELSE
 164         WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,8)
 165         write (igeom,'(a)')
 166         WRITE (igeom,190) (IHPB(I),JHPB(I),I=9,NSS)
 167       ENDIF
 168       write (igeom,'(i10)') klasa
 169 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 170       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 171       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 172 c     if (nvar.gt.nphi+ntheta) then
 173         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 174         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 175 c     endif
 176       close(igeom)
 177   180 format (I5,2F12.3,I2,$,8(1X,2I3,$))
 178   190 format (3X,11(1X,2I3,$))
 179   200 format (8F10.4)
 180       return
 181       end
 182 c---------------------------------------------------------------------------
 183       subroutine cartout(igr,i,etot,free,rmsd,plik)
 184       implicit real*8 (a-h,o-z)
 185       include 'DIMENSIONS'
 186       include 'sizesclu.dat'
 187       include 'COMMON.IOUNITS'
 188       include 'COMMON.CHAIN'
 189       include 'COMMON.VAR'
 190       include 'COMMON.LOCAL'
 191       include 'COMMON.INTERACT'
 192       include 'COMMON.NAMES'
 193       include 'COMMON.GEO'
 194       include 'COMMON.CLUSTER'
 195       character*80 plik
 196       open (igeom,file=plik,position='append')
 197       write (igeom,'(2e15.5,f10.5,$)') etot,free,rmsd
 198       write (igeom,'(i4,$)')
 199      &  nss_all(i),(ihpb_all(j,i),jhpb_all(j,i),j=1,nss_all(i))
 200       write (igeom,'(i10)') iscore(i)
 201       write (igeom,'(8f10.5)')
 202      &  ((allcart(k,j,i),k=1,3),j=1,nres),
 203      &  ((allcart(k,j+nres,i),k=1,3),j=nnt,nct)
 204       return
 205       end