source/cluster/unres/src/geomout.F

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