program raxer4 C This version subtracts a radial-dependent background and c multiplies by a radial dependent factor to show highresolution c and lowresolution simultraneously. structure /header/ union map byte bline(4096) end map map INTEGER*2 iline(4096) end map map character*10 device character*10 version character*20 crystal character*12 cry_sys real*4 cell(6) character*12 space real*4 mosaic character*80 memo integer*4 res1(21) character*12 date character*20 operator character*4 target real*4 wave character*20 monochro !mon name real*4 mono_2 !monoch 2theta dgr character*20 collimator character*4 filter real*4 camera_len !mm real*4 kvma(2) !X-ray power integer*4 res2(39) character*4 axis(2) real*4 phi0 !phi0 real*4 phist !phistart real*4 phiend !phiend integer*4 osc real*4 ex_time real*4 xray(2) !x,z - xray beam pos. num of pixels real*4 circle(3) !omega, chi 2theta dgr integer*4 res3(52) integer*4 pix_num(2) !x z number of pixels real*4 pix_size(2) !x z pix size (mm) integer*4 record(2) !rec length and number integer*4 read_start integer*4 ip_num real*4 ratio !hi/lo ratio real*4 fading(2) integer*4 res4(53) end map end union end structure record /header/ header CHARACTER DAT*12,TIM*12,filedate*23 CHARACTER*80 TITLE CHARACTER*50 INFILE CHARACTER*50 FILENAME CHARACTER*40 FNAME,ASTRING c integer*1 outstring(3800) c byte outstring(3800) CHARACTER*1 OUTSTRING(3800) LOGICAL EFLG R64K=256*256 R32K=128*256 WRITE(6,1000) 1000 FORMAT(//' RAXIS-2 TO POSTSCRIPT IMAGE FILE CONVERSION . PROGRAM Version 950107'/' To print image: PLW "OUTPUT".ps') 5001 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) IF (EFLG) GOTO 5 write(6,11001) goto 5001 11001 format(/' FILE DOES NOT EXIST ') 5 OPEN (UNIT=2,FILE=INFILE,STATUS='OLD') J=LIB$SPAWN('dir/date/width=(fil=19)/outp=1.tmp '//infile) astring=infile j=index(astring,']') if (j.ne.0) astring=astring(j+1:) j=index(astring,':') if (j.ne.0) astring=astring(j+1:) J=LIB$SPAWN('search/outp=2.tmp 1.tmp '//astring) open (unit=10,file='2.tmp',status='old') read (10,'(a)')title filedate=title(22:44) write(6,*)'filedate=',filedate,'xxx' close (unit=10) TYPE *,'Enter source for coordinates of boxes around spots:' TYPE *,'CR-no boxes. D-denzo outfile.' READ(5,'(A1)')BOXFLAG IF (BOXFLAG.EQ.' ') GOTO 335 IF (BOXFLAG.EQ.'d') BOXFLAG='D' 330 TYPE *,'ENTER FILENAME FOR BOX COORD FILE:' 340 FORMAT (A40) read(5,'(a)') fname 335 continue C335 WRITE(6,1600) 1600 FORMAT('$Output filename: ') C READ(5,1200) outfilmx !!!VS07/07 file name instead Marxer.ps OPEN (UNIT=3,FILE='RAXXER.TIF',STATUS='NEW',recl=950, & CARRIAGECONTROL='LIST') 1400 write(6,*)'Enter window (pixels; xmin,xmax,ymin,ymax;', . ' 0 0 0 0 for default):' read(5,*) j1,j2,i1,i2 c (j1 refers to x, i1 to y -- see definition below in terms of record structure) WRITE(6,*)'Enter density limits (min,max) or 0,0 to autoscale' WRITE(6,*)'Density autoscaling requires two passes through the file.' READ(5,*)X0,XM WRITE(6,*)'Enter background to be subtracted from center:' READ(5,*) bgrnd CALL DATE(DAT) CALL TIME(TIM) C read HEADER into bline, encode into titles: READ(2,155) (header.BLINE(ii),ii=1,2048) 155 FORMAT (4096A1) TYPE *,'TIME: ',header.DATE TYPE *,'DISTANCE: ',header.CAMERA_len TYPE *,'LAMBDA: ',header.wave TYPE *,'PHI_START: ',header.PHIST TYPE *,'PHI_END: ',header.PHIEND TYPE *,'pix_X: ',header.PIX_NUM(1) TYPE *,'Pix_Z: ',header. PIX_NUM(2) type *,'memo: ',header.memo DMEAN=0 DMAX=-1E32 DMIN=1E32 NX=HEADER.PIX_NUM(1) NY=HEADER.PIX_NUM(2) ENCODE(80,6739,TITLE) HEADER.DATE,filedate 6739 FORMAT(' R-AXIS image of: ',A12,' Filedate:',a23) PIX=HEADER.PIX_size(1) yscale=HEADER.PIX_size(2)/PIX c according to header, pixels are .105 mm square. c actually x-pixels are smaller by 1.032 write(6,*)'pix, yscale=',pix,yscale yscale=1.032 pix=pix/yscale 72 FORMAT(' ',A80) WRITE(6,72)TITLE c write(3,'(A)') '50 752 moveto ('//title//') show' ENCODE(80,6745,TITLE) HEADER.EX_TIME 6745 FORMAT(' EXPOSURE TIME (MIN)',F7.2) WRITE(6,72)TITLE c write(3,'(A)') '50 732 moveto ('//title//') show' ENCODE(80,6741,TITLE) HEADER.WAVE,HEADER.CAMERA_len, 1 HEADER.PHIST,HEADER.PHIEND 6741 FORMAT('LAMBDA: ',F11.4,' DISTANCE:',F9.2,' PHI:',2F9.2) WRITE (6,72)TITLE c write(3,'(A)') '50 742 moveto ('//title//') show' title=header.memo c write(3,'(A)') '50 712 moveto ('//title//') show' c Save lambda, distance for calculating resolution: wl=HEADER.WAVE dist = HEADER.CAMERA_len IF (XM.GT.0) GOTO 87 TYPE *,'READING IMAGE. FIRST PASS: FINDING MIN, MAX DENSITY' DO 85 IY = 1,NY READ(2,155,end=860) (HEADER.BLINE(II),II=1,3800) DO 80 IX=1,NX X=header.ILINE(IX) IF (X.LT.0)X=X+R64K DMEAN=DMEAN+X IF (X.GT.DMAX) DMAX=X 80 IF (X.LT.DMIN) DMIN=X 85 CONTINUE nyt=ny GOTO 865 860 nyt=iy-1 865 CLOSE(UNIT=2) c use only number of record read in computing average 870 DMEAN=DMEAN/(NX*NYt) TYPE *,'DMIN=',DMIN,' DMAX=',DMAX,' DMEAN=',DMEAN ENCODE(80,6750,TITLE) DMIN,DMAX,DMEAN ENCODE(80,6750,TITLE) DMIN,DMAX,DMEAN 6750 FORMAT('RAXER V950107: Min/Max/mean density = ',2f8.0,f8.2) c write(3,'(A)') '50 702 moveto ('//title//') show' OPEN (UNIT=2,FILE=INFILE,STATUS='OLD') C SKIP OVER HEADER FOR NOW: READ(2,155) (header.BLINE(II),II=1,2048) X0=DMEAN/2 XM=DMEAN*3 87 SCALE=(XM-X0)/256 if (j2.eq.0) then I1=0 I2=1899 J1=0 J2=1899 else if (I1.gt.1897) I1=1897 if (I2.gt.1899) I2=1899 if (J1.gt.1897) J1=1897 if (J2.gt.1899) J2=1899 endif in=1+i2-i1 jn=1+j2-j1 nmax=in if (jn.gt.nmax) nmax=jn ENCODE(80,6742,TITLE) X0,XM,J1,J2,I1,I2 6742 FORMAT('Density Limits:',2F8.1, . ' Selected Map Limits (X,Y)=',4I5) WRITE (6,72)TITLE c write(3,'(A)') '50 762 moveto ('//title//') show' ENCODE(80,6743,TITLE) float(nmax)/20.,pix*float(nmax)/20. 6743 FORMAT('Scale: 1 cm=',F8.2,' x-pixels =',f8.3, . ' mm on imaging plate') WRITE (6,72)TITLE c write(3,'(A)') '50 722 moveto ('//title//') show' C write(3,'(A)') '583 363.6 translate -90 rotate' C write(3,'(A)') '0 4 moveto (TOP (view from source)) cshow' C WRITE POSTSCRIPT PRELUDE: c WRITE(3,'(A)')'gsave initgraphics' c WRITE(3,'(A)')' {1 exch sub} settransfer' c note i1,i2,in refer to dimension across records. c MRC considers this Y, mars X c j1,j2,jn refer to dimension along one record. MRC X, mars Y. DO 88 IY = 1,I1-1 88 READ(2,155,end=980) (header.BLINE(II),II=1,3800) DO 95 IY = I1,I2 READ(2,155,end=980) (header.BLINE(II),II=1,3800) DO 90 IX=J1,J2 X=header.ILINE(IX) rad=sqrt(float((ix-950)*(ix-950)+(iy-950)*(iy-950))) x=x-(bgrnd*(1.-rad/950.)) x=x*(1+3*rad/950.) c write (6,*)' ix,iy,rad,corr =',ix,iy,rad,(bgrnd*(1.-rad/950.)) IF (X.LT.0)X=X+XM JX=INT((X-X0)/SCALE) IF (JX.GT.255) JX=255 IF (JX.LT.0) JX=0 90 OUTSTRING(IX)=char(JX) 95 WRITE(3,156)(OUTSTRING(IX),IX=J1,J2) 156 FORMAT(125A1) GOTO 990 980 WRITE(6,*)'UNEXPECTED END OF FILE READING IMAGE FILE! FILL W WHITE.' iyt=iy do 97 ix=j1,j2 97 outstring(ix)=char(0) do 98 iy=iyt,i2 98 WRITE(3,156)(OUTSTRING(IX),IX=J1,J2) 990 CLOSE (UNIT=3) GOTO 5001 985 CLOSE(UNIT=2) end