program renum

c**********************************************************************
c This progran renumbers the residues in a clean PDB file.
c It uses the existing number of the first residue as
c the first number and increments from there.
c
c It looks for either N (protein) or P DNA to start new residue
c
c       Copyright (c) Yale University, New Haven, CT 06520
c       All rights reserved.
c       The program either in full or in part should not be distributed
c       in any form or by any means without the prior written
c       permission of the author:
c
c       Patrick Fleming
c       Yale University
c       Dept. of Molecular Biophysics and Biochemistry
c       P. O. Box 208114
c       260 Whitney Ave.
c       New Haven, CT 06520-8114
c       fleming@csb.yale.edu
c
c************************************************************

c Declarations
       character line*80,kywrd*4
       character pada*13,atm*4,res1*3,res2*3,padb*54
       character fname*30, prompt*30
       integer num,onenum

       data prompt / 'PDB filename to be renumbered?' /

c Open the current input and output files.
       call askfil(1,fname,'old',prompt)
       open (unit=2,file='new.pdb',status='unknown')       
       write(6,599)
599    format('     Renumbered file is called new.pdb')

c Read the current first residue number
       num=0
5      read(1,'(a80)',END=90)line 
       if (line(1:4) .eq. 'ATOM') then
          backspace (unit=1)
          read(1,'(a12,1x,a4,a3,2x,i4,a54)')pada,atm,res1,onenum,padb
c         print*,res1
          num=onenum     !set num = to actual first res number
c Write first record to output
          write(2,'(a12,1x,a4,a3,2x,i4,a54)')pada,atm,res1,num,padb
       else    
          go to 5
       end if
       do while (.true.)
          read(1,'(a12,1x,a4,a3,2x,i4,a54)',end=95)pada,atm,res2,
     +          onenum,padb
c         print*,res1,res2
          if ((res1 .eq. res2) .and. (atm .ne. 'N   ') .and.
     1       (atm .ne. 'P   ') .and.
     2       (res2 .ne. 'WAT') .and. (res2 .ne. 'HOH') .and.
     3       (res2 .ne. 'ZN ') .and. (res2 .ne. 'PO4') .and.
     4       (res2 .ne. 'SO4') .and. (res2 .ne. 'HEM')) then 
             write(2,'(a12,1x,a4,a3,2x,i4,a54)')pada,atm,res2,num,padb
          else   !Now on to next residue
             if (pada(1:3) .eq. 'END') go to 95
	     if (pada(1:3) .eq. 'TER') go to 85
             num=num+1
             write(2,'(a12,1x,a4,a3,2x,i4,a54)')pada,atm,res2,num,padb
             res1=res2
85	  continue
          end if
       end do
90     print*,'ERROR: No ATOM record'
95     continue
       write(2,'(a3)')'END'
       close (unit=1)
       close (unit=2)
       stop
       end
*****************************************************************

        SUBROUTINE askfil ( lunit, fname, age, prompt )

****************************************************************

        INTEGER lunit		!Unit number
        CHARACTER*3    age              ! either "OLD" or "NEW"
        CHARACTER*(*)  prompt, fname
C
C               THE SIZE OF THE MESSAGE BUFFER IS DEFINED AT RUN TIME
C               SINCE IT IS USED AS A PASSED LENGTH STRING. FNAME IS 
C               A LOCALLY DEFINED CONSTANT CURRENTLY SET AT 30.
C                                                             
C                                                             
        WRITE(6,600) prompt
        READ(5,500) FNAME
        write(6,610)

        IF ( ( age .EQ. 'old' ) .OR. ( age .EQ. 'OLD' ) ) THEN
            OPEN ( UNIT = lunit, NAME = fname, STATUS = 'OLD')
        ELSE IF ( ( age .EQ. 'new' ) .OR. ( age .EQ. 'NEW' ) ) THEN
            OPEN ( UNIT = lunit, NAME = fname, STATUS = 'NEW')
        END IF
        WRITE(6,630) fname, age

500     FORMAT ( A30 )
600     FORMAT ( 2x,A, '---->'$ )
610     FORMAT ( X )
630     FORMAT(5X,A,'Status=', A3)

        RETURN
        END