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) CHARACTER*36 RECLINE(30) EQUIVALENCE (RECLINE(1),BLINE(1)) real*4 rline(256),TCELL(6),CELL(6) EQUIVALENCE (RLINE(1),BLINE(1)),(TCELL(1),RLINE(11)) INTEGER*4 LINT(256),n,ii EQUIVALENCE (LINT(1),BLINE(1)) INTEGER*2 NX,NY,NZ,NXYZ(3) EQUIVALENCE (NX,NXYZ(1)),(NY,NXYZ(2)),(NZ,NXYZ(3)) CHARACTER*80 TTITLE,TITLE,TSYMTRY,SYMTRY EQUIVALENCE (TTITLE,RLINE(57)) EQUIVALENCE (TSYMTRY,RLINE(1)) CHARACTER*50 INFILE,OUTFILE,FILENAME DIMENSION RMAP(500,500) CHARACTER*40 FNAME,ASTRING CHARACTER*1 OUTSTRING(1200),HSTRING(16),xyzstr(3) LOGICAL*4 EFLG integer*2 ZLP CHARACTER DAT*12,TIM*12 pi=4*ATAN(1.) R64K=256*256 R32K=128*256 DATA HSTRING/'0','1','2','3','4','5','6','7','8','9','A','B','C', - 'D','E','F'/ DATA XYZSTR/'X','Y','Z'/ write(6,*)'eflg=',eflg c DO 2 I=1,16 c2 WRITE(6,*)I,' ',HSTRING(I) WRITE(6,1000) 1000 FORMAT(//' CCP4 DENSITY MAP TO POSTSCRIPT IMAGE FILE CONVERSION . PROGRAM Version 940628'/' To print image: LPR MapXer.TMP') 5 WRITE(6,1100) 1100 FORMAT(/'$Input filename (CR to quit): ') READ(5,1200) INFILE 1200 FORMAT(A) IF (INFILE(:5).EQ.' ') STOP INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG) WRITE(6,*)'INFILE=',INFILE,'EFLG=',EFLG,'FILENAME=',FILENAME IF (.NOT.EFLG) GOTO 5 OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',FORM='UNFORMATTED') C1400 write(6,*)'Enter window (pixels; xmin,xmax,ymin,ymax;', C . ' 0 0 0 0 for default):' C read(5,*) i1,i2,j1,j2 C WRITE(6,*)'Enter density limits (min,max) or 0,0 to autoscale' C WRITE(6,*)'Density autoscaling requires two passes through the file.' C READ(5,*)X0,XM C WRITE(6,1600) READ(2)(RLINE(I),I=1,256) C These dimensions are actual dimens present in map- maybe < full unit cell 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: c correspond to true x,y,z axes, regardles of order in map. NX=LINT(8) NY=LINT(9) NZ=LINT(10) iaxf=lint(17) iaxm=lint(18) iaxsl=lint(19) C MFAST, MED, SLOW ARE FULL UNIT CELL IN THOSE DIRECTIONS mfast=nxyz(iaxf) mmed=nxyz(iaxm) mslow=nxyz(iaxsl) 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)=',IAXF, & IAXM,IAXSL 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.GT.500).OR.(NMED.GT.500)) STOP & 'DIMENSIONED FOR 500X500 SECTIONS ONLY!' 295 write(6,*)'Enter number of ',XYZSTR(IAXSL),'-layer to plot:' write(6,*) '(considering first layer is 1, not 0!)' read(5,*)zlp if ((zlp.lt.1).or.(zlp.gt.nslow)) goto 295 II=1+NSYMCHAR/4 C !!!IF NSYMCHAR NOT A MULTIPLE OF 4, SHOULD ROUND UP, NOT DOWN? DO 325 LAYER=1,nslow DO 300 J=1,NMED DO 300 K=1,NFAST IF (II.GT.256) THEN READ(2,END=900)(RLINE(IJ),IJ=1,256) II=1 ENDIF RMAP(J,K)=RLINE(II) 300 II=II+1 if(Layer.ne.Zlp) goto 325 86 WRITE(6,*)'Layer:',layer X0=DMIN XM=DMAX IF (XM.EQ.XO) XM=X0+1 87 SCALE=(XM-X0)/16 nmax=mfast if (mmed.gt.nmax) nmax=mmed OPEN (UNIT=3,FILE='MAPXER.TMP',STATUS='NEW',RECL=1200, & CARRIAGECONTROL='LIST') WRITE(3,'(A)')'%!PS-Adobe-' write(3,'(A)')'/Times-Roman findfont 9 scalefont setfont' write(3,'(A)') & '/cshow {dup stringwidth pop 2 div neg 0 rmoveto show} def' c--------- CALL DATE(DAT) CALL TIME(TIM) write(3,'(A)') '50 770 moveto'// & '(Map File: '//FILENAME//' Printed:',DAT,TIM,') show' c--------- write(3,'(A)') '50 750 moveto ('//title//') show' c--------- c ENCODE(80,6742,TITLE) X0,XM,0,nfast-1,0,nmed-1,ZLP c6742 FORMAT('Density Limits:',2F8.1, c . ' Map Limits (X,Y)=',4I5,' Z=',i5) ENCODE(80,6742,TITLE) X0,XM,xyzstr(iaxf), . xyzstr(iaxm),0,nfast-1,0,nmed-1,xyzstr(iaxsl),ZLP 6742 FORMAT('Density Limits:',2F8.1, . ' Map Limits (',a1,', ',a1,')=',4I5,' ',a1,'=',i5) WRITE (6,72)TITLE 72 FORMAT(' ',A80) write(3,'(A)') '50 760 moveto ('//TITLE//') show' c--------- cellf=cell(iaxf) cellm=cell(iaxm) gamma=cell(3+iaxsl) pscale=cellf/10 pscale=int(pscale) write(6,75)xyzstr(iaxf),cellf,xyzstr(iaxm),cellm, gamma, Pscale 75 Format(' assuming cell ',a1,'=',F6.2,' ',a1,'=',F6.2,'Angle=',f6.2, . ' Plot scale=',F6.2,'Angst/cm') ENCODE(80, 75 ,TITLE)xyzstr(iaxf),cellf,xyzstr(iaxm),cellm, gamma, . Pscale write(3,'(A)') '50 740 moveto ('//TITLE//') show' c--------- ENCODE(80,6750,TITLE) DMIN,DMAX,DMEAN 6750 FORMAT('MAPXER V920704: Min/Max/mean density = ',3e12.3) write(3,'(A)') '50 730 moveto ('//TITLE//') show' write(3,'(A)') '50 720 moveto (Origin at lower left, ', . xyzstr(iaxf),' to right, ',xyzstr(iaxm),' up ) show' WRITE(3,'(A)')'gsave initgraphics' WRITE(3,'(A)')' {1 exch sub} settransfer' nx2=nfast if (nx2.ne.(2*int(nx2/2))) then nx2=nfast+1 endif WRITE(3,76) nx2/2 76 format (' /imline ',i4,' string def') gamma=pi*gamma/180 write(3,77) NFAST,NMED,float(NFAST)/CELLF, . -float(NFAST)/(CELLF*TAN(GAMMA)), . float(NMED)/(CELLM*SIN(GAMMA)) 77 format (' /drawimage {',2i5,' 4 [',f8.5,' 0 ',2f8.5,' 0 0]') WRITE(3,'(A)')' {currentfile imline readhexstring pop} image} def' c scale for one unit = 1 angstrom at Pscale angstrom/cm write(3,74) 72./(2.540*pscale) 74 Format(' 225 75 translate ',f8.4,' dup scale') ! WRITE(3,'(A)')'drawimage' outstring(nx2)=hstring(5) do 95 I=1,nmed do 90,j=1,NFAST c (valid data is j=1,nfast; if nx2>nfast the extra byte is c written (95) but discarded by postscript) x=RMAP(I,J) C write(6,*)x JX=INT((X-X0)/SCALE) IF (JX.GT.15) JX=15 IF (JX.LT.0) JX=0 90 OUTSTRING(j)=HSTRING(JX+1) 95 WRITE(3,156)(OUTSTRING(j),j=1,nx2) 156 FORMAT(125A1) C WRITE OUT REST OF POSTSCRIPT: write(3,167) cellf,cellf+cellm*cos(gamma),cellm*sin(gamma), . cellm*cos(gamma),cellm*sin(gamma) 167 format(' 0 0 moveto ',f8.2,' 0 lineto ',2f8.2,' lineto ', . 2f8.2,' lineto 0 0 lineto') WRITE(3,'(A)')'0.000855 setlinewidth closepath' WRITE(3,'(A)')'{} settransfer stroke' 501 WRITE(3,'(A)')' showpage grestore' CLOSE (UNIT=3) write(6,*)'LPR-ing mapxer.tmp' J=LIB$SPAWN('LPR MAPXER.TMP') C J=LIB$SPAWN('DEL MAPXER.TMP;*') write(6,*)'not purging mapxer.tmp' C J=LIB$SPAWN('PURGE MAPXER.TMP') write(6,*) 'enter next(later) layer to plot (0 to quit):' read(5,*)zlp if ((zlp.lt.1).or.(zlp.gt.nslow)) goto 380 325 CONTINUE 380 CLOSE(UNIT=2) STOP 'NORMAL END' 900 STOP 'END OF FILE BEFORE END OF MAP' END