PROGRAM checkwat3 c Reads output of second pass through cover2 and lists c those solvents which need to deleted or checked CHARACTER*103 filnam, line REAL wt(0:6,600:999), df(0:6,600:999), f(0:6,600:999), 1 x(0:6,600:999), y(0:6,600:999), z(0:6,600:999), 2 b(0:6,600:999), dist(0:6,600:999), mat(3,3,2:6) DO i = 600,999 !Trick to know which waters found wt(1,i) = 0.0 endDO c Get PDB mnemonic WRITE (6, 1000) 'Enter PDB mnemonic:' 1000 FORMAT (a) READ (5, 1000) filnam len = length(filnam) OPEN (unit=9, form='FORMATTED', status='UNKNOWN', 1 file=filnam(1:len)//'.checkwat') c First do Diamond file (cover2 output) OPEN (unit=1, form='FORMATTED', status='OLD', readonly, 1 file=filnam(1:len)//'.cover2') DO WHILE (.TRUE.) 10 READ (1, 1000, end=99) line IF (line(66:68) .NE. 'WAT' .AND. line(66:68) .NE. 'TIP') goto 10 999 FORMAT (i4) READ (line(69:72), 999) num isub = ICHAR(line(73:73))-64 READ (line, 1001) wt(isub,num), df(isub,num), f(isub,num) 1001 FORMAT (55x, f8.4, 16x, 4f8.1) endDO 99 CLOSE (unit=1) c Read in matrices to rotate protomers B-F onto A OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 1 file='/home/ohlen/pcd/AVERINV.MEP') READ (1, 1000) DO n = 2,6 READ (1, 9001) ((mat(i,j,n), i=1,3), j=1,3) 9001 FORMAT (9f10.5) endDO CLOSE (unit=1) c Now do PDB file OPEN (unit=1, form='FORMATTED', status='OLD', readonly, 1 file=filnam(1:len)//'.pdb') DO WHILE (.TRUE.) 11 READ (1, 1000, end=199) line IF (line(1:4) .NE. 'ATOM' .AND. line(1:6) .NE. 'HETATM') goto 11 IF (line(18:20) .NE. 'WAT' .AND. line(18:20) .NE. 'TIP') goto 11 READ (line(23:26), 999) num isub = ICHAR(line(73:73))-64 READ (line(31:54), 1002) xx, yy, zz 1002 FORMAT (3f8.4) IF (isub .NE. 1) THEN !Rotate protomers B-F onto A x(isub,num) = xx*mat(1,1,isub) + yy*mat(2,1,isub) + zz*mat(3,1,isub) y(isub,num) = xx*mat(1,2,isub) + yy*mat(2,2,isub) + zz*mat(3,2,isub) z(isub,num) = xx*mat(1,3,isub) + yy*mat(2,3,isub) + zz*mat(3,3,isub) ELSE x(1,num) = xx y(1,num) = yy z(1,num) = zz endIF IF (num .LE. 602) THEN WRITE (6, 6001) num, line(73:73), x(isub,num), y(isub,num), z(isub,num) 6001 FORMAT (i4, 1x, a, 1x, 3f8.4) endIF READ (line(61:66), 1003) b(isub,num) 1003 FORMAT (f6.2) endDO 199 CLOSE (unit=1) c Calculate means DO num = 600, 999 IF (wt(1,num) .NE. 0.) THEN x(0,num) = (x(1,num)+x(2,num)+x(3,num)+x(4,num)+ 1 x(5,num)+x(6,num))/6. y(0,num) = (y(1,num)+y(2,num)+y(3,num)+y(4,num)+ 1 y(5,num)+y(6,num))/6. z(0,num) = (z(1,num)+z(2,num)+z(3,num)+z(4,num)+ 1 z(5,num)+z(6,num))/6. b(0,num) = (b(1,num)+b(2,num)+b(3,num)+b(4,num)+ 1 b(5,num)+b(6,num))/6. df(0,num) = (df(1,num)+df(2,num)+df(3,num)+df(4,num)+ 1 df(5,num)+df(6,num))/6. f(0,num) = (f(1,num)+f(2,num)+f(3,num)+f(4,num)+ 1 f(5,num)+f(6,num))/6. DO j = 1,6 dist(j,num) = SQRT((x(0,num)-x(j,num))**2 + 1 (y(0,num)-y(j,num))**2 + (z(0,num)-z(j,num))**2) endDO dist(0,num) = (dist(1,num)+dist(2,num)+dist(3,num)+dist(4,num)+ 1 dist(5,num)+dist(6,num))/6. endIF endDO c Write table of results OPEN (unit=1, form='FORMATTED', status='UNKNOWN', 1 file=filnam(1:len)//'.wat') DO num = 600, 999 IF (wt(1,num) .NE. 0.0) THEN WRITE (1, 2001) num, (CHAR(i+64), i=1,6) 2001 FORMAT (i4, 3x, 6(3x, a1, 3x), ' Aver') WRITE (1, 2002) 'Dist ', (dist(i,num), i=1,6), dist(0,num) 2002 FORMAT (a, 2x, 7f7.3) WRITE (1, 2002) 'Bfact', (b(i,num), i=1,6), b(0,num) WRITE (1, 2002) '2FoFc', (f(i,num), i=1,6), f(0,num) WRITE (1, 2002) 'FoFc ', (df(i,num), i=1,6), df(0,num) endIF endDO CLOSE (unit=1) c Get limits for averages and individual measures WRITE (6, 1000) 'Enter max dist, min/max b, min/max f, min/max df for aver:' WRITE (9, 1000) 'Enter max dist, min/max b, min/max f, min/max df for aver:' READ (5, 3001) dma, bma, bmax, fma, fmax, dfma, dfmax IF (dma .LE. 0.0) dma = 0.60 IF (bma .LE. 0.0) bma = 10. IF (bmax .LE. 0.0) bmax = 50. IF (fma .LE. 0.0) fma = 1.2 IF (fmax .LE. 0.0) fmax = 4.0 IF (dfma .EQ. 0.0) dfma = -1.0 IF (dfmax .EQ. 0.0) dfmax = 1.0 WRITE (6, 3001) dma, bma, bmax, fma, fmax, dfma, dfmax WRITE (9, 3001) dma, bma, bmax, fma, fmax, dfma, dfmax WRITE (6, 1000) 'Enter same for individual protomers:' WRITE (9, 1000) 'Enter same for individual protomers:' READ (5, 3001) dm, bm, bmx, fm, fmx, dfm, dfmx IF (dm .LE. 0.0) dm = dma*1.5 IF (bm .LE. 0.0) bm = bma /2. IF (bmx .LE. 0.0) bmx = bmax + 15. IF (fm .LE. 0.0) fm = MAX(fma * 2./3., fma - 0.5) IF (fmx .LE. 0.0) fmx = fmax + 1. IF (dfm .EQ. 0.0) dfm = dfma*2. IF (dfmx .EQ. 0.0) dfmx = dfmax*2. WRITE (6, 3001) dm, bm, bmx, fm, fmx, dfm, dfmx WRITE (9, 3001) dm, bm, bmx, fm, fmx, dfm, dfmx 3001 FORMAT (7f8.3) c Make list of waters to delete or check DO num = 600, 999 IF (wt(1,num) .NE. 0.0) THEN IF (dist(0,num) .GT. dma) goto 350 !too far IF (b(0,num) .LT. bma) goto 450 !B too low IF (b(0,num) .GT. bmax) goto 350 !B too high IF (f(0,num) .LT. fma) goto 350 !2Fo-Fc too weak IF (f(0,num) .GT. fmax) goto 451 !2Fo-Fc too strong IF (df(0,num) .LT. dfma) goto 350 !Fo-Fc too negative IF (df(0,num) .GT. dfmax) goto 452 !Fo-Fc too positive DO i = 1,6 IF (dist(i,num) .GT. dm) goto 350 IF (b(i,num) .LT. bm) goto 453 IF (b(i,num) .GT. bmx) goto 350 IF (f(i,num) .LT. fm) goto 350 IF (f(i,num) .GT. fmx) goto 454 IF (df(i,num) .LT. dfm) goto 350 IF (df(i,num) .GT. dfmx) goto 455 endDO goto 500 350 WRITE (6, 3002) 'Delete', num WRITE (9, 3002) 'Delete', num 3002 FORMAT (a, i7, 3x, a) goto 500 450 WRITE (6, 3002) 'Check ', num, '-- Average B too low' WRITE (9, 3002) 'Check ', num, '-- Average B too low' goto 500 451 WRITE (6, 3002) 'Check ', num, '-- Average 2Fo-Fc too strong' WRITE (9, 3002) 'Check ', num, '-- Average 2Fo-Fc too strong' goto 500 452 WRITE (6, 3002) 'Check ', num, '-- Average Fo-Fc too positive' WRITE (9, 3002) 'Check ', num, '-- Average Fo-Fc too positive' goto 500 453 WRITE (6, 3002) 'Check ', num, '-- Protomer B too low' WRITE (9, 3002) 'Check ', num, '-- Protomer B too low' goto 500 454 WRITE (6, 3002) 'Check ', num, '-- Protomer 2Fo-Fc too strong' WRITE (9, 3002) 'Check ', num, '-- Protomer 2Fo-Fc too strong' goto 500 455 WRITE (6, 3002) 'Check ', num, '-- Protomer Fo-Fc too positive' WRITE (9, 3002) 'Check ', num, '-- Protomer Fo-Fc too positive' 500 continue endIF endDO CLOSE (unit=9) end INTEGER FUNCTION length(line) CHARACTER*103 line DO i = 103,1,-1 IF (line(i:i) .NE. ' ') goto 9 endDO 9 length = i return end