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