c read PDB file in orthogonal system (later read any pdb, convert to orth axes) c no, read RDI. convert pdb to rdi w pdb2rdi AFTER REMOVING nonatom records c operate with specified rotation + translation c put into arbitrary unit cell (given orth axis relative to cell vectors) c (write out this file for use by sfclc) c read MEP file c check for overlap of protein between asu's: c for each atom c operate on atom with each MEP operation c check atom in new position for overlap with each atom of primary position c (If primary position does not overlap with any other, that ensures c there will be no overlap between an positions?) REAL*4 V(3),W(3),RM(3,3),A,B,ANGLE,COSA,SINA,SYMOP(3,4,12) REAL*4 D(3,20000),CELLA,CELLB,CELLC,ALPHA,BETA,GAMMA,CELL(3,3) REAL*8 RCELL(4,4) INTEGER I,J,K,I1,I2,I3 CHARACTER*15 RESI CHARACTER*40 FNAME CHARACTER*1 AXIS character*80 astring WRITE(6,*) 'PROGRAM TO CHECK .RDI FILE FOR COLLISION BETWEEN' WRITE(6,*) 'ASYMMETRIC UNITS. .RDI FILE HAS ORTH COORDINATES' WRITE(6,*) 'WRITE NEW .RDI FILE WITH COOR AU ALONG CELL AXES' pi=4*atan(1.0) radius=5 30 TYPE *,'ENTER FILE NAME OF RDI FILE TO CHECK:' 35 read(5,40)FNAME IF (FNAME.EQ.'Q') GOTO 501 40 FORMAT (A40) OPEN(UNIT=2,FILE=FNAME,STATUS='OLD') WRITE(6,*)'ENTER A B C ALPHA BETA GAMMA:' READ(5,*) CELLA,CELLB,CELLC,ALPHA,BETA,GAMMA alpha=alpha*pi/180. beta=beta*pi/180 gamma=gamma*pi/180 CELL(1,1)=CELLA CELL(2,1)=0 CELL(3,1)=0 CELL(1,2)=CELLB*COS(GAMMA) CELL(2,2)=CELLB*SIN(GAMMA) CELL(3,2)=0 CELL(1,3)=CELLC*COS(BETA) CELL(2,3)=CELLC*COS(ALPHA)*SIN(BETA) CELL(3,3)=CELLC*SIN(ALPHA)*SIN(BETA) DO 405 I=1,3 DO 405 J=1,3 405 RCELL(I,J)=CELL(I,J) N=3 m=3 call matprn(rcell,n,m) CALL MATINV(RCELL,N,DET) write(6,*) call matprn(rcell,n,m) c TEST MATRIX INVERSION do 407 i=1,3 do 406 j=1,3 v(j)=0. do 406 k=1,3 406 v(j)=v(j)+rcell(i,k)*cell(k,j) 407 write(6,*)(v(j),j=1,3) C IF V IS COOORD IN FRACTION ALONG UNIT CELL => X = CELL * V C SO V CAN BE OBTAINED AS V = RCELL * X C MEP operators work on V, not on X. WRITE(6,*) 'ENTER NAME OF .MEP FILE WITH SYM OPS' READ(5,40)FNAME OPEN (UNIT=4,FILE=FNAME,STATUS='OLD') READ(4,*)NSYM DO 41 K=1,NSYM READ(4,*) ((SYMOP(I,J,K),I=1,3),J=1,4) WRITE(6,*) DO 41 I=1,3 SYMOP(I,4,K)=SYMOP(I,4,K)/12. !TRANSLATION STORED AS 12 * TRANSL 41 WRITE(6,42) (SYMOP(I,J,K),J=1,4) 42 FORMAT(12F8.4) CLOSE (UNIT=4) 49 format (a80) DO 48 I=1,3 read(2,49) astring 48 WRITE(6,*) ASTRING L=0 C 20.000 32.000 4.000 0.000 2 1 0 1.00 ALA 1 N 50 format (4f10.3,3I5,f8.2,A15) C50 format (4f10.3,3I5,f8.2,' ALA 1 N ') C50 format ('HETATM',I5,' N ALA A 1 ',3f8.3,2f6.2) 55 read(2,50,END=501) (v(i),i=1,3),a,I1,I2,I3,B,RESI L=L+1 cccc write (6,*) (v(i),i=1,3) C IF D IS COOORD IN FRACTION ALONG UNIT CELL => V = CELL * D C SO D CAN BE OBTAINED AS D = RCELL * V C MEP operators work on V, not on X. do 92 i=1,3 D(i,L)=0 do 92 j=1,3 92 D(i,L)=D(i,L)+rcell(i,j)*V(j) DO 93 I=1,3 IF (D(I,L).LT.0.) D(I,L)=D(I,L)+1.0 93 IF (D(I,L).GT.1.) D(I,L)=D(I,L)-1.0 ccccc write (6,*) (D(I,L),i=1,3) IF (L.LT.20000) GOTO 55 WRITE(6,*)' STOP READING FILE AFTER 20,000 ATOMS!' 501 CONTINUE M=L WRITE(6,*)M,' ATOMS LOADED.' DO 700 L=1,M DO 700 ksym=2,nsym c operate on atom with symmetry operator: do 95 i=1,3 w(i)=symop(i,4,ksym) do 90 j=1,3 90 w(i)=w(i)+symop(i,j,ksym)*D(j,L) IF (W(I).LT.0.) W(I)=W(I)+1.0 !PUT IT BACK IN THE CELL! 95 IF (W(I).GT.1.) W(I)=W(I)-1.0 C DO 700 LL=L,M !CHECK FOR OVERLAP WITH ITSELF OR LATER ATOM DO 700 LL=1,M !CHECK FOR OVERLAP WITH ITSELF OR ANY ATOM DIST=0 DO 620 I=1,3 620 V(I)=W(I)-D(I,LL) !GET DIF VECTOR IN FRACTIONAL UNITS DO 640 I=1,3 !MULT BY CELL TO GET BACK TO ANGST UNITS DX=0 DO 630 J=1,3 630 DX=DX+CELL(I,J)*V(J) 640 DIST=DIST+DX*DX DIST=SQRT(DIST) CCCC WRITE(6,641)L,KSYM,LL,(W(I),I=1,3),(D(I,LL),I=1,3),(V(I),I=1,3),DIST 641 FORMAT (3I5,' *',3F8.4,' *',3F8.4,' *',3F8.4,' *',F8.2) IF (DIST.LT.RADIUS) THEN WRITE(6,651)KSYM,L,(D(I,L),I=1,3),LL,(D(I,L),I=1,3),DIST COUNT=COUNT+1 651 format('CRASH: OPERATOR ',i3,' ON ATOM ',I5,' AT ', & 3F7.5,' WITH ',I5,' AT ',3F7.5,' DIST='3F7.2) ENDIF 700 CONTINUE WRITE(6,*) M,' ATOMS CHECKED. FOUND ',COUNT, & ' COLLISIONS CLOSER THAN ',RADIUS END SUBROUTINE MATPRN(ARRAY,M,N) C DOUBLE PRECISION ARRAY REAL*8 ARRAY(4,4) DO 10 I=1,M 10 WRITE (6,*) (ARRAY(I,J),J=1,N) RETURN END SUBROUTINE MATINV (ARRAY, NORDER, DET) DOUBLE PRECISION ARRAY, AMAX, SAVE 2 DIMENSION ARRAY(4,4), IK (10), JK (10) 10 DET = 1 11 DO 100 K=1, NORDER C C FIND LARGEST ELEMENT ARRAY(I,J) IN REST OF MATRIX C AMAX=0 21 DO 30 I=K, NORDER DO 30 J=K, NORDER 23 IF (DABS (AMAX) - DABS (ARRAY(I,J) ) ) 24, 24, 30 24 AMAX=ARRAY(I,J) IK(K) =I JK(K) =J 30 CONTINUE C C INTERCHANGE ROWS AND COLUMNS TO PUT AMAX IN ARRAY(K,K) C 31 IF (AMAX) 41, 32, 41 32 DET=0. GO TO 140 41 I=IK (K) IF (I-K) 21, 51, 43 43 DO 50 J=1, NORDER SAVE= ARRAY(K,J) ARRAY(K,J)= ARRAY(I,J) 50 ARRAY(I,J)= -SAVE 51 J=JK (K) IF (J-K) 21, 61, 53 53 DO 60 I=1, NORDER SAVE= ARRAY(I,K) ARRAY(I,K)= ARRAY(I,J) 60 ARRAY(I,J)= -SAVE C C ACCUMULATE ELEMENTS OF INVERSE MATRIX C 61 DO 70 I=1, NORDER IF(I-K) 63, 70, 63 63 ARRAY(I,K) = -ARRAY(I,K) / AMAX 70 CONTINUE 71 DO 80 I=1, NORDER DO 80 J=1, NORDER IF (I-K) 74, 80, 74 74 IF (J-K) 75, 80, 75 75 ARRAY(I,J) = ARRAY(I,J) + ARRAY(I,K) *ARRAY(K,J) 80 CONTINUE 81 DO 90 J=1, NORDER IF (J-K) 83, 90, 83 83 ARRAY(K,J) = ARRAY(K,J) / AMAX 90 CONTINUE ARRAY(K,K) = 1. / AMAX 100 DET=DET *AMAX C C RESTORE ORDERING OF MATRIX C 101 DO 130 L=1, NORDER K= NORDER - L +1 J= IK (K) IF (J-K) 111, 111, 105 105 DO 110 I=1, NORDER SAVE= ARRAY(I,K) ARRAY(I,K)= -ARRAY(I,J) 110 ARRAY(I,J)= SAVE 111 I= JK(K) IF (I-K) 130, 130, 113 113 DO 120 J=1, NORDER SAVE= ARRAY(K,J) ARRAY(K,J) = -ARRAY(I,J) 120 ARRAY(I,J)= SAVE 130 CONTINUE 140 RETURN END