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