C- READ 1024 BYTES AT A TIME. 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),xyzstr(3) CHARACTER*36 RECLINE(30) EQUIVALENCE (RECLINE(1),BLINE(1)) real*4 rline(256),TCELL(6),CELL(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) integer*2 plusmin,plusmax,minmin,minmax integer*2 NX, NY, NZ, NXYZ(3) EQUIVALENCE (NX,NXYZ(1)),(NY,NXYZ(2)),(NZ,NXYZ(3)) integer*2 NNX, NNY, NNZ, NNXYZ(3) EQUIVALENCE (NNX,NNXYZ(1)),(NNY,NNXYZ(2)),(NNZ,NNXYZ(3)) EQUIVALENCE (LINT(1),BLINE(1)) CHARACTER*80 TTITLE,TITLE,TSYMTRY,SYMTRY EQUIVALENCE (TTITLE,RLINE(56)) EQUIVALENCE (TSYMTRY,RLINE(1)) CHARACTER*50 INFILE,OUTFILE,FILENAME LOGICAL*1 INSIDE DIMENSION RMAP(0: 99,0:119, 0:99) C (MED, FAST, SLOW) DATA XYZSTR/'X','Y','Z'/ WRITE(6,1001) 1001 FORMAT(//' PROGRAM TO READ CCP4 MAP FILES, CHABGE DIMENSIONS' . //' ADD BLANK SPACE OR TRUNCATE TO SMALLER CELL ', . //' CELL DIMEN CAN BE REDEFINED INDEPENDANTLY ', . //' new map written to same filename, next version') 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') READ(2)(RLINE(I),I=1,256) c*** C These dimensions are actual dimens present in map- maybe < sample NFAST=LINT(1) NMED=LINT(2) NSLOW=LINT(3) maptype=LINT(4) nsfast=lint(5) nsmed=lint(6) nsslow=lint(7) DO 290 I=1,6 290 CELL(I)=TCELL(I) C These dimensions are sampling dimensions, corresp to full unit cell: NX=LINT(8) NY=LINT(9) NZ=LINT(10) 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) TITLE=TTITLE WRITE(6,*)'NFAST, MEDIUM, SLOW=',NFAST,NMED,NSLOW WRITE(6,*)'MAP TYPE=',MAPTYPE WRITE(6,*)'START (FAST, MED, SLOW)=',NSFAST,NSMED,NSSLOW WRITE(6,*)'CELL: ',(CELL(I),I=1,6) WRITE(6,*)'SAMPLING(NX, NY, NZ)=',NX, NY, NZ WRITE(6,*)'AXIS PERMUTAION (FAST, MEDIUM, SLOW)=',IAXFAST, & IAXMED,IAXSLOW WRITE(6,*)'DMIN, DMAX, DMEAN, DDEV=',DMIN,DMAX,DMEAN,DDEV WRITE(6,*)'SPACE GROUP #',NSG WRITE(6,*)'# CHAR OF SYM INFO:',NSYMCHAR WRITE(6,*)'NUMBER OF TITLES:',NTITLE WRITE(6,*) TITLE READ(2)(RLINE(I),I=1,256) SYMTRY=TSYMTRY WRITE(6,*)SYMTRY if ((nfast.le.120).and.(nmed.le.100).and.(nslow.le.100)) goto 10 stop 'dimensioned for nfast=120, nmed=100, nslow=100. map exceeds!' 10 II=1+NSYMCHAR/4 C !!!IF NSYMCHAR NOT A MULTIPLE OF 4, SHOULD ROUND UP, NOT DOWN? DO 325 K=0,NSLOW-1 C WRITE(6,*)'SECTION ',J DO 300 I=0,NMED-1 DO 300 J=0,NFAST-1 IF (II.GT.256) THEN READ(2,END=1900)(RLINE(IJ),IJ=1,256) 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***********************************put here what you want to change: C cell(1)=21.2 C cell(2)=cell(1) C cell(3)=35.2 C I MED Y C J FAST X C K SLOW Z 1500 write (6,*)'enter new dimensions for fast, medium, and slow axes' read(5,*) nnfast,nnmed,nnslow WRITE(6,*) 'DOES THIS CORRESPOND TO FULL UNIT CELL(y/n)?' READ(5,1003)INFILE IF ((INFILE(:1).EQ.'N').OR.(INFILE(:1).EQ.'n')) THEN WRITE(6,*)' ENTER SAMPLING (PIXELS IN WHOLE CELL) FOR a, b, c:' read(5,*) nnx, nny, nnz ELSE NNXYZ(IAXFAST)=NNFAST NNXYZ(IAXMED)=NNMED NNXYZ(IAXSLOW)=NNSLOW ENDIF WRITE(6,*)'ENTER NEW CELL DIMENSION A,B, C:' READ(5,*) (TCELL(I),I=1,3) WRITE(6,*)'SUMMARY: AXIS X/Y/Z OLDGRID OLDSAMPLE OLDLENGTH NEWGRID . NEWSAMPLE NEWLENGTH' WRITE(6,1509) 'FAST',XYZSTR(IAXFAST),NFAST,NXYZ(IAXFAST),CELL(IAXFAST), . NNFAST,NNXYZ(IAXFAST),TCELL(IAXFAST) WRITE(6,1509) 'MEDIUM',XYZSTR(IAXMED),NMED,NXYZ(IAXMED),CELL(IAXMED), . NNMED,NNXYZ(IAXMED),TCELL(IAXMED) WRITE(6,1509) 'SLOW',XYZSTR(IAXSLOW),NSLOW,NXYZ(IAXSLOW),CELL(IAXSLOW), . NNSLOW,NNXYZ(IAXSLOW),TCELL(IAXSLOW) 1509 FORMAT (2X,A10,A2,2I10,F10.3,2I10,F10.3) WRITE(6,*)' IS THIS RIGHT? (N TO REDO)' READ(5,1003)INFILE IF ((INFILE(:1).EQ.'N').OR.(INFILE(:1).EQ.'n')) goto 1500 DO 1510 I=1,3 C NXYZ(I)=NXYZ(I)*TCELL(I)/CELL(I) !PIXEL SIZE MUSTNT CHANGE. 1510 CELL(I)=TCELL(I) c******************************************************************** outfile='new.map' OPEN (UNIT=3,FILE=outfile,STATUS='NEW',FORM='UNFORMATTED', & RECL=256, RECORDTYPE='FIXED', CARRIAGECONTROL='NONE') DO 400 I=1,256 400 RLINE(I)=0 LINT(1)=NNFAST !NEW, (LARGER?) DIMENSIONS LINT(2)=NNMED LINT(3)=NNSLOW LINT(4)=maptype lint(5)=nsfast lint(6)=nsmed lint(7)=nsslow LINT(8)=NNX LINT(9)=NNY LINT(10)=NNZ DO 490 I=1,6 490 TCELL(I)=CELL(I) lint(17)=iaxfast lint(18)=iaxmed lint(19)=iaxslow rline(20)=dmin rline(21)=dmax rline(22)=dmean lint(23)=nsg lint(24)=nsymchar rline(55)=ddev lint(56)=ntitle TTITLE=TITLE WRITE(3)(RLINE(I),I=1,256) DO 493 I=1,20 493 RLINE(I)=0 TSYMTRY=SYMTRY II=1+NSYMCHAR/4 DO 1600 K=0,NNSLOW-1 WRITE(6,*)'SECTION ',k DO 1600 I=0,NNMED-1 DO 1600 J=0,NNFAST-1 IF (II.GT.256) THEN WRITE(3)(RLINE(IJ),IJ=1,256) II=1 ENDIF C GET A VALUE FOR THE NEXT (I,J,K'TH) PIXEL IF((K.LE.NSLOW-1).AND.(I.LE.NMED-1).AND.(J.LE.NFAST-1)) THEN RLINE(II)=RMAP(I,J,K) ELSE RLINE(II)=0 ENDIF !VERY SLOW BUT CONCEPTUALLY SIMPLE. 1600 II=II+1 WRITE(3)(RLINE(I),I=1,256) CLOSE(UNIT=3) STOP 'NORMAL END' 1900 STOP 'END OF FILE BEFORE END OF MAP' END