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