C- RESECTION CCP4 MAP C- READ INTO ARRAY COMMON WITH 256 REAL*4, 256 INT*4, 1 BYTE STRINGS C- PICK OUT THE VALUES FOR A CCP4 DENSITY MAP, BE THEY CHARACTER, INTEGER, C- OR REAL (DENSITIES ARE REAL). CHARACTER*1 BLINE(1024) character*4 TLINE(256),symtry(512) EQUIVALENCE (TLINE(1),BLINE(1)) real*4 rline(256),TCELL(6),CELL1(6),cell2(6) REAL*4 RMX(3,3),RMY(3,3),RMZ(3,3),TEMP(3,3),PROD(3,3),X1(3),X2(3) EQUIVALENCE (RLINE(1),BLINE(1)),(TCELL(1),RLINE(11)) INTEGER*4 LINT(256),ITRANS(3) EQUIVALENCE (LINT(1),BLINE(1)) CHARACTER*80 TTITLE,TITLE !,TSYMTRY,SYMTRY EQUIVALENCE (TTITLE,RLINE(57)) EQUIVALENCE (TSYMTRY,RLINE(1)) CHARACTER*50 INFILE,OUTFILE,FILENAME LOGICAL*1 INSIDE DIMENSION RMAP(120,120,300) cc******DIMENSION RMAP(NMED,NSLOW,NFAST) FOR INPUT MAP!!! CC******CHANGE 2 PLACES BELOW IN IF BLOCK IF CHANGED HERE! WRITE(6,1001) 1001 FORMAT(//' PROGRAM TO RESECTION CCP4 MAP FILES', @ /' SWAP MEDIUM OR FAST WITH SLOW AXES, WRITE TO NEW.MAP') 5 WRITE(6,1002) 1002 FORMAT(/'$Input filename (CR to quit): ') READ(5,1003) INFILE 1003 FORMAT(A) C IF (INFILE(:5).EQ.' ') STOP C INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG) C IF (.NOT.EFLG) GOTO 5 OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',FORM='UNFORMATTED', . access='direct',recl=256) READ(2)RLINE NFAST=LINT(1) NMED=LINT(2) NSLOW=LINT(3) MAPTYPE=LINT(4) DO 290 I=1,6 290 CELL1(I)=TCELL(I) NX1=LINT(8) NY1=LINT(9) NZ1=LINT(10) NSYMCHAR=RLINE(55) TITLE=TTITLE iaxfast=lint(17) iaxmed=lint(18) iaxslow=lint(19) dmin=rline(20) dmax=rline(21) dmean=rline(22) nsg=lint(23) nsymchar=lint(24) ddev=RLINE(55) ntitle=lint(56) WRITE(6,*)'NFAST, MEDIUM, SLOW=',NFAST,NMED,NSLOW IF ((NFAST.GT.300).OR.(NMED.GT.120).OR.(NSLOW.GT.120)) THEN STOP 'DIMENSIONED FOR 300,120,120 !' ENDIF WRITE(6,*)'MAPTYPE=',MAPTYPE write(6,*)' IAXFAST, MEDIUM, SLOW =',IAXFAST,IAXMED,IAXSLOW WRITE(6,*)'CELL: ',(CELL1(I),I=1,6) WRITE(6,*)'NX1, NY1, NZ1=',NX1, NY1, NZ1 WRITE(6,*)'#CHAR IN SYMOPS',NSYMCHAR WRITE(6,*) TITLE READ(2)RLINE c SYMTRY=TSYMTRY c WRITE(6,*)SYMTRY ii=1 do 295 i=1,nsymchar/4 IF (II.GT.256) THEN READ(2,END=1900) RLINE II=1 ENDIF symtry(i)=TLINE(II) !if symtry char*4 c write(6,*)ii,tline(ii) 295 ii=ii+1 c do 296 i=1,nsymchar/80-1 c ii=20*(i-1) c296 write(6,*) ii,(symtry(ii+j),j=1,20) c II=1+NSYMCHAR/4 C !!!!IF NSYMCHAR NOT MULTIPLE OF 4, SHOULD ROUND UP? DO 325 J=1,NSLOW-1 C WRITE(6,*)'SECTION ',J DO 300 I=1,NMED DO 300 K=1,NFAST IF (II.GT.256) THEN READ(2,END=1900) RLINE II=1 ENDIF RMAP(I,J,K)=RLINE(II) C I,J,K CORRESPOND TO X,Y,Z, OR NMED, NSLOW, NFAST 300 II=II+1 325 CONTINUE 380 CLOSE(UNIT=2) C NOW WE HAVE THE WHOLE MAP IN MEMORY! C PREPARE SOME THINGS: WRITE(6,*)' ENTER 0 TO SWAP MED AND SLOW (X,Y), OR ' WRITE(6,*) 'ENTER 1 TO SWAP FAST AND SLOW (Z,Y) AXES:' READ(5,*) ISWAP OPEN (UNIT=3,FILE='new.map',STATUS='unknown',FORM='UNFORMATTED', & RECL=256, access='direct', CARRIAGECONTROL='NONE') DO 400 I=57,256 400 TLINE(I)=' ' DO 410 I=1,56 410 RLINE(I)=0 LINT(4)=MAPTYPE DO 490 I=1,6 490 TCELL(I)=CELL1(I) RLINE(55)=RMYST TTITLE=TITLE rline(20)=DMIN rline(21)=DMAX rline(22)=DMEAN lint(23)=NSG lint(24)=NSYMCHAR RLINE(55)=DDEV lint(56)=NTITLE LINT(8)=NX1 LINT(9)=NY1 LINT(10)=NZ1 IF (ISWAP.EQ.0) THEN C SWAP MED AND SLOW AXES: 500 LINT(1)=NFAST LINT(3)=NMED LINT(2)=NSLOW lint(17)=IAXFAST lint(18)=IAXSLOW lint(19)=IAXMED WRITE(3) RLINE ii=1 DO 600 I=1,nsymchar/4 IF (II.GT.256) THEN write(6,*)' writing a record:' WRITE(3) RLINE II=1 ENDIF TLINE(II)=symtry(I) c write (6,*)ii,tline(ii) 600 ii=ii+1 c II=1+NSYMCHAR/4 DO 700 I=1,NMED C WRITE(6,*) WRITE(6,*)'SECTION ',I DO 700 J=1,NSLOW DO 700 K=1,NFAST IF (II.GT.256) THEN WRITE(3) RLINE II=1 ENDIF RLINE(II)=RMAP(I,J,K) 700 II=II+1 ELSE C SWAP FAST AND SLOW AXES LINT(3)=NFAST LINT(2)=NMED LINT(1)=NSLOW lint(17)=IAXSLOW lint(18)=IAXMED lint(19)=IAXFAST WRITE(3)RLINE ii=1 DO 800 I=1,nsymchar/4 IF (II.GT.256) THEN write(6,*)' writing a record:' WRITE(3) RLINE II=1 ENDIF TLINE(II)=symtry(I) c write (6,*)ii,tline(ii) 800 ii=ii+1 c II=1+NSYMCHAR/4 DO 1500 K=1,NFAST C WRITE(6,*) WRITE(6,*)'SECTION ',K DO 1500 I=1,NMED DO 1500 J=1,NSLOW IF (II.GT.256) THEN WRITE(3)RLINE II=1 ENDIF RLINE(II)=RMAP(I,J,K) 1500 II=II+1 ENDIF WRITE(3) RLINE CLOSE(UNIT=3) STOP 'NORMAL END' 1900 STOP 'END OF FILE BEFORE END OF MAP' END