logical eflg dimension ires(500),xyz(100,3),xyzold(3) character*20 infile,filename character*13 astring character*6 bstring character*11 cstring 5 WRITE(6,*)'ENTER NAME PDB file to be corrected:' READ(5,1200) INFILE 1200 FORMAT(A) IF (INFILE(:5).EQ.' ') STOP INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG) IF (.NOT.EFLG) stop OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',READONLY) 6 WRITE(6,*)'ENTER NAME for output PDB file:' READ(5,1200) INFILE IF (INFILE(:5).EQ.' ') STOP OPEN (UNIT=3,FILE=INFILE,STATUS='UNKNOWN') C read all the whatcheck water lines: i=1 210 read (5,220,end=300) astring,ires(i),(xyz(i,j),j=1,3) c write(6,*)i,'aaa',astring,'zzz',ires(i) 220 format (4x,A13,I9,3f9.3) if (astring.ne.' HOH (HOH )') goto 210 i=i+1 goto 210 C read the pdb lines and switch if residue number in list 300 nchange=i-1 write(6,*)'Number to change: ',nchange c write(6,*)'testpoint 1' 310 read (2,51,end=400) bstring,iatm,cstring, . iresold,(xyzold(j),j=1,3),occ,bfact 51 format (A6,I5,A11,i4,' ',3f8.3,2f6.2) do 350 i=1,nchange if (iresold.eq.ires(i)) then c write(6,*)'Exchanging coordinates for water#',ires(i) write (6,51) bstring,iatm,cstring, . iresold,(xyzold(j),j=1,3),occ,bfact do 340 j=1,3 340 xyzold(j)=xyz(i,j) write (6,51) bstring,iatm,cstring, . iresold,(xyzold(j),j=1,3),occ,bfact endif 350 continue write (3,51) bstring,iatm,cstring, . iresold,(xyzold(j),j=1,3),occ,bfact goto 310 400 continue write(6,*)'Done! Toodle Pip!' close (unit=2) close (unit=3) end