Logo Search packages:      
Sourcecode: raster3d version File versions  Download package

rings3d.f

      PROGRAM RINGS3D
*------------------------------------------------------------------------------
*       Program to set up input for RENDER by filling in 5- and 6-member rings
*     with triangles.
*
* EAM May 1999    - initial version
*             residue types are hard-wired in DATA statements
*             planes are not smoothed
* EAM Nov 2008    - revise for use with TLSMD
*------------------------------------------------------------------------------
      implicit none
c
      include 'VERSION.incl'
c
c     I/O units and environmental control
c
      integer input, output, noise
      parameter (input=5, output=6, noise=0)
      integer     narg
c     integer     iargc
c     external    iargc
      character*64      options
      logical           bflag, pflag, sflag, rflag
c
c     Data arrays
c
      integer            MAXATOM,       MAXCOL
      parameter   (MAXATOM=10000, MAXCOL=1000)
      real      rgb(3,MAXCOL), vdw(MAXCOL)
      real        x(MAXATOM), y(MAXATOM), z(MAXATOM)
      integer         resno(MAXATOM), color(MAXATOM)
      character*1 chain(MAXATOM)
      character*4 resname(MAXATOM), name(MAXATOM)
c
      character*24 mask(MAXCOL),test
      character*80 card
      logical match
c
c     General storage
c
      integer     i,j,n
      integer ncol, icol, nrings 
      integer natm, iatm, jatm
      integer ind(10)
      integer ringsize
      real    red,grn,blu
C
C     Known residue types containing one or two rings
C     Each row contains a residue name (type) in the first entry
C     followed by up to 9 atom names which define the ring[s].
C     A blank name terminates the list for this residue type.
C
C     Five-membered rings (e.g. furanose)
C     connect atoms (1,2,5)(2,3,5)(3,4,5)
C     => atoms 1 and/or 4 can be out-of-plane, but not 2,3,5
C     Six-membered rings (e.g. pyranose)
C     connect atoms (1,2,6)(2,3,5)(2,5,6)(3,4,5)
C     => atoms 1 and/or 4 can be out-of-plane, but not 2,3,5,6
C     Nine-membered rings are assumed to be a conjugated ring system
C
C
C     To add a new residue type:
c           increase NTYPES by 1
c           add row of atom names to type array
c           adjust start/end indices of protein/base/sugar flags
c           optional:  add default colour record
C
      integer        NTYPES
      parameter (NTYPES=28)
      character*4 type( 10, NTYPES )
      integer           nhits( NTYPES )
      integer           p_start, p_end, b_start, b_end, s_start, s_end
C
C     Default to solid color
C
      integer    DEFCOLS
      parameter (DEFCOLS=6)
      character*60 defcol(DEFCOLS)
      data defcol /
     & 'COLOUR###########  A##########   0.501   0.501   1.000  2.00',
     & 'COLOUR###########  C##########   1.000   0.398   0.063  2.00',
     & 'COLOUR###########  G##########   1.000   0.101   0.101  2.00',
     & 'COLOUR###########  T##########   0.501   1.000   0.501  2.00',
     & 'COLOUR###########  U##########   0.501   1.000   0.501  2.00',
     & 'COLOUR########################   0.800   0.800   0.800  2.00'
     &            /
c
      data type /
     &  ' HIS',' CG ',' ND1',' CE1',' NE2',' CD2',   ' ',' ',' ',' ',
     &  ' PHE',' CG ',' CD1',' CE1',' CZ ',' CE2',' CD2',' ',' ',' ',
     &  ' TYR',' CG ',' CD1',' CE1',' CZ ',' CE2',' CD2',' ',' ',' ',
     &  ' TRP',' CZ2',' CH2',' CZ3',' CE3',' CD2',' CE2',
     &         ' CG ',' CD1',' NE1',
     &      ' GAL',' C1 ',' C2 ',' C3 ',' C4 ',' C5 ',' O5 ',' ',' ',' ',
     &      ' NAG',' C1 ',' C2 ',' C3 ',' C4 ',' C5 ',' O5 ',' ',' ',' ',
     &      ' NGA',' C1 ',' C2 ',' C3 ',' C4 ',' C5 ',' O5 ',' ',' ',' ',
     &      ' GLC',' C1 ',' C2 ',' C3 ',' C4 ',' C5 ',' O5 ',' ',' ',' ',
     &      ' MAN',' C1 ',' C2 ',' C3 ',' C4 ',' C5 ',' O5 ',' ',' ',' ',
     &      ' MNG',' C1 ',' C2 ',' C3 ',' C4 ',' C5 ',' O5 ',' ',' ',' ',
     &      ' SIA',' C2 ',' C3 ',' C4 ',' C5 ',' C6 ',' O6 ',' ',' ',' ',
     &      ' RIP',' O4''',' C4''',' C3''',' C2''',' C1''',' ',' ',' ',' ',
     &  '  +C',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '  +T',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '  +U',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '  +A',' N3 ',' C2 ',' N1 ',' C6 ',' C5 ',' C4 ',
     &         ' N7 ',' C8 ',' N9 ',
     &  '  +G',' N3 ',' C2 ',' N1 ',' C6 ',' C5 ',' C4 ',
     &         ' N7 ',' C8 ',' N9 ',
     &  '   C',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '   T',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '   U',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '   A',' N3 ',' C2 ',' N1 ',' C6 ',' C5 ',' C4 ',' N7 ',' C8 ',' N9 ',
     &  '   G',' N3 ',' C2 ',' N1 ',' C6 ',' C5 ',' C4 ',' N7 ',' C8 ',' N9 ',
     &  '  DC',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '  DT',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '  DU',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' ',' ',' ',
     &  '  DA',' N3 ',' C2 ',' N1 ',' C6 ',' C5 ',' C4 ',' N7 ',' C8 ',' N9 ',
     &  '  DG',' N3 ',' C2 ',' N1 ',' C6 ',' C5 ',' C4 ',' N7 ',' C8 ',' N9 ',
     &  ' PDC',' N1 ',' C2 ',' N3 ',' C4 ',' C5 ',' C6 ',' C9 ',' C8 ',' N7 '
     &  / 
c
      data p_start, p_end / 1,  4 /
      data s_start, s_end / 5, 12 /
      data b_start, b_end /13, 28 /
c
      do i = 1, NTYPES
            nhits(i) = 0
      enddo
c
      bflag  = .FALSE.
      pflag  = .FALSE.
      sflag  = .FALSE.
      rflag  = .FALSE.
      narg  = iargc()
      i = 0
  100 continue
      i = i + 1
      if (i.gt.narg) goto 199
            call getarg( i, options )
            if (options(1:2) .eq. '-b') then
            bflag = .true.
            else if (options(1:2) .eq. '-p') then
            pflag = .true.
            else if (options(1:2) .eq. '-s') then
            sflag = .true.
            else if (options(1:2) .eq. '-r') then
            rflag = .true.
            else
            goto 101
            endif
      goto 100
c
  101 continue
      write (noise,'(A)') 
     &           'syntax: rings3d [-options] < infile.pdb > outfile.r3d'
      write (noise,'(A)') 
     &           '        -bases    A/C/G/T/U DA/+A/etc'
      write (noise,'(A)') 
     &           '        -ribose   sugar in A/C/G/T/U DA/+A/etc'
      write (noise,'(A)') 
     &           '        -protein  HIS/PHE/TRP/TYR'
      write (noise,'(A)') 
     &           '        -sugars   GAL/GLC/MAN/NAG/NGA/SIA'

      call exit(-1)
  199 continue
      if (.not.bflag .and. .not.pflag .and. .not.rflag) sflag = .true.
c
      write (noise,*) 'Raster3D rings3d program ',VERSION
c
c     Read in colours first
c
      ncol = 0
      natm = 0
  200 continue
        read(input,'(a80)',end=250) card

        if (card(1:4).eq.'COLO') then
          ncol = ncol + 1
          if (ncol.gt.MAXCOL) then
            write(noise,*) 'Colour table overflow.  Increase ',
     &                     'MAXCOL and recompile.'
            stop 10
          endif
          read(card,'(6x,a24,3f8.3,f6.2)') mask(ncol),
     &          (rgb(i,ncol),i=1,3),vdw(ncol)

        elseif (card(1:4).eq.'ATOM'.or.card(1:4).eq.'HETA') then
*         Load default colors after any that were read in
          if (natm.eq.0.and.ncol.le.MAXCOL-DEFCOLS) then
            do i = 1,DEFCOLS
              ncol = ncol + 1
              read(defcol(I),'(6x,a24,3f8.3,f6.2)') mask(ncol),
     &            (rgb(j,ncol),j=1,3), vdw(ncol)
            enddo
          endif
*         Now we read in ATOM record
          natm = natm + 1
          if (natm.gt.MAXATOM) then
            write(noise,*) 'Atom array overflow.  Increase ',
     &                     'MAXATOM and recompile.'
            stop 20
          endif
          test = card(7:30)
          do icol = 1, ncol
            if (match(test,mask(icol))) then
                  color(natm)   = icol
                  read(card,901) resno(natm),x(natm),y(natm),z(natm)
901           format(22x,i4,4x,3f8.3)
            name(natm)    = card(13:16)
            resname(natm) = card(17:20)
            chain(natm)   = card(22:22)
            goto 220
            endif
          enddo
  220     continue

        elseif (card(1:3).eq.'END') then
          go to 250
        endif

        go to 200

*     Come here when EOF or 'END' record is reached
  250 continue
      if (natm.eq.0) then
        write(noise,*) 'No atoms in input.'
        stop 30
      else
        write(noise,*) 'Input atoms: ',natm
      endif
      
c
C     Here


















































's the real loop.  C    nrings = 0  jatm = 0  300     continue    iatm = jatm + 1   if (iatm.ge.natm) goto 399c   do j = iatm, natm   if (resno(j).eq.resno(iatm)     &    .and.chain(j).eq.chain(iatm)) then         jatm = j        else          goto 301        endif     enddo  301  continue    if (bflag) then     do n = b_start, b_end     if (resname(iatm)(2:4).eq.type(1,n)(2:4)) goto 310        enddo     endif if (pflag) then     do n = p_start, p_end     if (resname(iatm)(2:4).eq.type(1,n)(2:4)) goto 310        enddo     endif if (sflag) then     do n = s_start, s_end     if (resname(iatm)(2:4).eq.type(1,n)(2:4)) goto 310        enddo     endifc       Look for base names, but use sugar ring (ribopyranose)     if (rflag) then     do n = b_start, b_end     if (resname(iatm)(2:4).eq.type(1,n)(2:4)) then          goto 309        endif     enddo     endif goto 300  309   continuec       Found a ribose inside a base      n = b_start - 1  310    continue    ringsize = 9      if (rflag) n = b_start - 1    do i = 2, 10        if (type(i,n).eq.' 









') then         ringsize = i - 2        goto 320        endif       do j = iatm, jatm         if (type(i,n).eq.name(j)) then        ind(i-1) = j            goto 312        endifc      Allow for incorrect column          if ((type(1,n)(1:1).eq.' 





') .and.     &          (type(i,n)(2:4).eq.name(j)(1:3))) then          ind(i-1) = j            goto 312        endif     enddo       write(noise,*) 'Cannot find atom ',type(i,n),' in














',     &                   type(1,n), resno(iatm), chain(iatm)      goto 300  312   continue    enddo  320  continuecc  Found onec  nrings   = nrings + 1   nhits(n) = nhits(n) + 1       red = rgb(1,color(ind(1)))    grn = rgb(2,color(ind(1)))    blu = rgb(3,color(ind(1)))    write(output,321) type(1,n),resno(iatm),chain(iatm)  321    format('# ',a4,2x,i4,a1)
  322 format('1',/,3(3f8.2),3f6.3)

      if (ringsize.eq.5) then
        write(output,322) 
     &      x(ind(1)),y(ind(1)),z(ind(1)),
     &          x(ind(2)),y(ind(2)),z(ind(2)),
     &      x(ind(5)),y(ind(5)),z(ind(5)),
     &          red,grn,blu
        write(output,322) 
     &          x(ind(3)),y(ind(3)),z(ind(3)),
     &      x(ind(4)),y(ind(4)),z(ind(4)),
     &      x(ind(5)),y(ind(5)),z(ind(5)),
     &          red,grn,blu
        write(output,322) 
     &      x(ind(2)),y(ind(2)),z(ind(2)),
     &      x(ind(3)),y(ind(3)),z(ind(3)),
     &          x(ind(5)),y(ind(5)),z(ind(5)),
     &          red,grn,blu
      endif
      if (ringsize.ge.6) then
        write(output,322) 
     &          x(ind(2)),y(ind(2)),z(ind(2)),
     &      x(ind(3)),y(ind(3)),z(ind(3)),
     &      x(ind(5)),y(ind(5)),z(ind(5)),
     &          red,grn,blu
        write(output,322) 
     &          x(ind(1)),y(ind(1)),z(ind(1)),
     &      x(ind(2)),y(ind(2)),z(ind(2)),
     &      x(ind(6)),y(ind(6)),z(ind(6)),
     &          red,grn,blu
        write(output,322) 
     &          x(ind(3)),y(ind(3)),z(ind(3)),
     &      x(ind(4)),y(ind(4)),z(ind(4)),
     &      x(ind(5)),y(ind(5)),z(ind(5)),
     &          red,grn,blu
        write(output,322) 
     &          x(ind(2)),y(ind(2)),z(ind(2)),
     &      x(ind(5)),y(ind(5)),z(ind(5)),
     &      x(ind(6)),y(ind(6)),z(ind(6)),
     &          red,grn,blu
      endif
      if (ringsize.eq.9) then
        write(output,322) 
     &      x(ind(5)),y(ind(5)),z(ind(5)),
     &          x(ind(7)),y(ind(7)),z(ind(7)),
     &      x(ind(8)),y(ind(8)),z(ind(8)),
     &          red,grn,blu
        write(output,322) 
     &          x(ind(6)),y(ind(6)),z(ind(6)),
     &      x(ind(8)),y(ind(8)),z(ind(8)),
     &      x(ind(9)),y(ind(9)),z(ind(9)),
     &          red,grn,blu
        write(output,322) 
     &          x(ind(5)),y(ind(5)),z(ind(5)),
     &      x(ind(6)),y(ind(6)),z(ind(6)),
     &      x(ind(8)),y(ind(8)),z(ind(8)),
     &          red,grn,blu
      endif

      goto 300
  399 continue

      write (noise,*) 'Filled rings for',nrings,' residues'
      do i = 1,NTYPES
        if (nhits(i).gt.0) write (noise,*) '    ',type(1,i),nhits(i)
      enddo
c
c
c
      end


      LOGICAL FUNCTION MATCH (SUBJ, MASK)
      CHARACTER*24 SUBJ,MASK
      MATCH = .FALSE.
      DO I = 1, 24
        IF (SUBJ(I:I).NE.MASK(I:I) .AND. MASK(I:I).NE.'#') RETURN
      ENDDO
      MATCH = .TRUE.
      RETURN
      END

Generated by  Doxygen 1.6.0   Back to index