source/unres/src_MD-M/xdrf2pdb/geomout.F

   1       subroutine pdbout(etot,tytul,iunit)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   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       include 'COMMON.DISTFIT'
  11       include 'COMMON.MD'
  12       character*50 tytul
  13       dimension ica(maxres)
  14       write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
  15 cmodel      write (iunit,'(a5,i6)') 'MODEL',1
  16       if (nhfrag.gt.0) then
  17        do j=1,nhfrag
  18         iti=itype(hfrag(1,j))
  19         itj=itype(hfrag(2,j))
  20         if (j.lt.10) then
  21            write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
  22      &           'HELIX',j,'H',j,
  23      &           restyp(iti),hfrag(1,j)-1,
  24      &           restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
  25         else
  26              write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
  27      &           'HELIX',j,'H',j,
  28      &           restyp(iti),hfrag(1,j)-1,
  29      &           restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
  30         endif
  31        enddo
  32       endif
  33
  34       if (nbfrag.gt.0) then
  35
  36        do j=1,nbfrag
  37
  38         iti=itype(bfrag(1,j))
  39         itj=itype(bfrag(2,j)-1)
  40
  41         write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
  42      &           'SHEET',1,'B',j,2,
  43      &           restyp(iti),bfrag(1,j)-1,
  44      &           restyp(itj),bfrag(2,j)-2,0
  45
  46         if (bfrag(3,j).gt.bfrag(4,j)) then
  47
  48          itk=itype(bfrag(3,j))
  49          itl=itype(bfrag(4,j)+1)
  50
  51          write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
  52      &              2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
  53      &           'SHEET',2,'B',j,2,
  54      &           restyp(itl),bfrag(4,j),
  55      &           restyp(itk),bfrag(3,j)-1,-1,
  56      &           "N",restyp(itk),bfrag(3,j)-1,
  57      &           "O",restyp(iti),bfrag(1,j)-1
  58
  59         else
  60
  61          itk=itype(bfrag(3,j))
  62          itl=itype(bfrag(4,j)-1)
  63
  64
  65         write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
  66      &              2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
  67      &           'SHEET',2,'B',j,2,
  68      &           restyp(itk),bfrag(3,j)-1,
  69      &           restyp(itl),bfrag(4,j)-2,1,
  70      &           "N",restyp(itk),bfrag(3,j)-1,
  71      &           "O",restyp(iti),bfrag(1,j)-1
  72
  73
  74
  75         endif
  76
  77        enddo
  78       endif
  79
  80       if (nss.gt.0) then
  81         do i=1,nss
  82           write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
  83      &         'SSBOND',i,'CYS',ihpb(i)-1-nres,
  84      &                    'CYS',jhpb(i)-1-nres
  85         enddo
  86       endif
  87
  88       iatom=0
  89       do i=nnt,nct
  90         ires=i-nnt+1
  91         iatom=iatom+1
  92         ica(i)=iatom
  93         iti=itype(i)
  94         write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i)
  95         if (iti.ne.10) then
  96           iatom=iatom+1
  97           write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3),
  98      &      vtot(i+nres)
  99         endif
 100       enddo
 101       write (iunit,'(a)') 'TER'
 102       do i=nnt,nct-1
 103         if (itype(i).eq.10) then
 104           write (iunit,30) ica(i),ica(i+1)
 105         else
 106           write (iunit,30) ica(i),ica(i+1),ica(i)+1
 107         endif
 108       enddo
 109       if (itype(nct).ne.10) then
 110         write (iunit,30) ica(nct),ica(nct)+1
 111       endif
 112       do i=1,nss
 113         write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
 114       enddo
 115       write (iunit,'(a6)') 'ENDMDL'
 116   10  FORMAT ('ATOM',I7,'  CA  ',A3,I6,4X,3F8.3,f15.3)
 117   20  FORMAT ('ATOM',I7,'  CB  ',A3,I6,4X,3F8.3,f15.3)
 118   30  FORMAT ('CONECT',8I5)
 119       return
 120       end
 121 c------------------------------------------------------------------------------
 122       subroutine MOL2out(etot,tytul)
 123 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
 124 C format.
 125       implicit real*8 (a-h,o-z)
 126       include 'DIMENSIONS'
 127       include 'COMMON.CHAIN'
 128       include 'COMMON.INTERACT'
 129       include 'COMMON.NAMES'
 130       include 'COMMON.IOUNITS'
 131       include 'COMMON.HEADER'
 132       include 'COMMON.SBRIDGE'
 133       character*32 tytul,fd
 134       character*3 liczba
 135       character*6 res_num,pom,ucase
 136 #ifdef AIX
 137       call fdate_(fd)
 138 #elif (defined CRAY)
 139       call date(fd)
 140 #else
 141       call fdate(fd)
 142 #endif
 143       write (imol2,'(a)') '#'
 144       write (imol2,'(a)')
 145      & '#         Creating user name:           unres'
 146       write (imol2,'(2a)') '#         Creation time:                ',
 147      & fd
 148       write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
 149       write (imol2,'(a)') tytul
 150       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
 151       write (imol2,'(a)') 'SMALL'
 152       write (imol2,'(a)') 'USER_CHARGES'
 153       write (imol2,'(a)') '\@<TRIPOS>ATOM'
 154       do i=nnt,nct
 155         write (liczba,'(i3)') i
 156         pom=ucase(restyp(itype(i)))
 157         res_num = pom(:3)//liczba(2:)
 158         write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
 159       enddo
 160       write (imol2,'(a)') '\@<TRIPOS>BOND'
 161       do i=nnt,nct-1
 162         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
 163       enddo
 164       do i=1,nss
 165         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
 166       enddo
 167       write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
 168       do i=nnt,nct
 169         write (liczba,'(i3)') i
 170         pom = ucase(restyp(itype(i)))
 171         res_num = pom(:3)//liczba(2:)
 172         write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
 173       enddo
 174   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
 175   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
 176       return
 177       end
 178 c------------------------------------------------------------------------
 179       subroutine intout
 180       implicit real*8 (a-h,o-z)
 181       include 'DIMENSIONS'
 182       include 'COMMON.IOUNITS'
 183       include 'COMMON.CHAIN'
 184       include 'COMMON.VAR'
 185       include 'COMMON.LOCAL'
 186       include 'COMMON.INTERACT'
 187       include 'COMMON.NAMES'
 188       include 'COMMON.GEO'
 189       write (iout,'(/a)') 'Geometry of the virtual chain.'
 190       write (iout,'(7a)') '  Res  ','         d','     Theta',
 191      & '       Phi','       Dsc','     Alpha','      Omega'
 192       do i=1,nres
 193         iti=itype(i)
 194         write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
 195      &     rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
 196      &     rad2deg*omeg(i)
 197       enddo
 198       return
 199       end
 200 c---------------------------------------------------------------------------
 201       subroutine briefout(it,ener)
 202       implicit real*8 (a-h,o-z)
 203       include 'DIMENSIONS'
 204       include 'COMMON.IOUNITS'
 205       include 'COMMON.CHAIN'
 206       include 'COMMON.VAR'
 207       include 'COMMON.LOCAL'
 208       include 'COMMON.INTERACT'
 209       include 'COMMON.NAMES'
 210       include 'COMMON.GEO'
 211       include 'COMMON.SBRIDGE'
 212 c     print '(a,i5)',intname,igeom
 213 #if defined(AIX) || defined(PGI)
 214       open (igeom,file=intname,position='append')
 215 #else
 216       open (igeom,file=intname,access='append')
 217 #endif
 218       IF (NSS.LE.9) THEN
 219         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 220       ELSE
 221         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
 222         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
 223       ENDIF
 224 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 225       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 226       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 227 c     if (nvar.gt.nphi+ntheta) then
 228         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 229         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 230 c     endif
 231       close(igeom)
 232   180 format (I5,F12.3,I2,9(1X,2I3))
 233   190 format (3X,11(1X,2I3))
 234   200 format (8F10.4)
 235       return
 236       end
 237 #ifdef WINIFL
 238       subroutine fdate(fd)
 239       character*32 fd
 240       write(fd,'(32x)')
 241       return
 242       end
 243 #endif
 244 c----------------------------------------------------------------
 245       subroutine cartoutx(time)
 246       implicit real*8 (a-h,o-z)
 247       include 'DIMENSIONS'
 248       include 'COMMON.CHAIN'
 249       include 'COMMON.INTERACT'
 250       include 'COMMON.NAMES'
 251       include 'COMMON.IOUNITS'
 252       include 'COMMON.HEADER'
 253       include 'COMMON.SBRIDGE'
 254       include 'COMMON.DISTFIT'
 255       include 'COMMON.MD'
 256       double precision time
 257 #if defined(AIX) || defined(PGI)
 258       open(icart,file=cartname,position="append")
 259 #else
 260       open(icart,file=cartname,access="append")
 261 #endif
 262       write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
 263       write (icart,'(i4,$)')
 264      &   nss,(ihpb(j),jhpb(j),j=1,nss)
 265        write (icart,'(i4,20f7.4)') nfrag+npair,
 266      & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair)
 267       write (icart,'(8f10.5)')
 268      & ((c(k,j),k=1,3),j=1,nres),
 269      & ((c(k,j+nres),k=1,3),j=nnt,nct)
 270       close(icart)
 271       return
 272       end
 273 c-----------------------------------------------------------------
 274       subroutine cartout(time)
 275       implicit real*8 (a-h,o-z)
 276       include 'DIMENSIONS'
 277       include 'COMMON.CHAIN'
 278       include 'COMMON.INTERACT'
 279       include 'COMMON.NAMES'
 280       include 'COMMON.IOUNITS'
 281       include 'COMMON.HEADER'
 282       include 'COMMON.SBRIDGE'
 283       include 'COMMON.DISTFIT'
 284       include 'COMMON.MD'
 285       double precision time
 286       integer iret,itmp
 287       real xcoord(3,maxres2+2),prec
 288
 289       call xdrfopen_(ixdrf,cartname, "w", iret)
 290       call xdrffloat_(ixdrf, real(time), iret)
 291       call xdrffloat_(ixdrf, real(potE), iret)
 292       call xdrffloat_(ixdrf, real(uconst), iret)
 293       call xdrffloat_(ixdrf, real(t_bath), iret)
 294       call xdrfint_(ixdrf, nss, iret)
 295       do j=1,nss
 296         call xdrfint_(ixdrf, ihpb(j), iret)
 297         call xdrfint_(ixdrf, jhpb(j), iret)
 298       enddo
 299       call xdrfint_(ixdrf, nfrag+npair, iret)
 300       do i=1,nfrag
 301         call xdrffloat_(ixdrf, real(qfrag(i)), iret)
 302       enddo
 303       do i=1,npair
 304         call xdrffloat_(ixdrf, real(qpair(i)), iret)
 305       enddo
 306       prec=10000.0
 307       do i=1,nres
 308        do j=1,3
 309         xcoord(j,i)=c(j,i)
 310        enddo
 311       enddo
 312       do i=nnt,nct
 313        do j=1,3
 314         xcoord(j,nres+i-nnt+1)=c(j,i+nres)
 315        enddo
 316       enddo
 317
 318       itmp=nres+nct-nnt+1
 319       call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
 320       call xdrfclose_(ixdrf, iret)
 321       return
 322       end