PROGRAM GNOMP c author : Dr. Paul D. Carr c Department of Chemistry, c University of Liverpool, c P.O.Box 147 c Liverpool L69 3BX c c e-mail pdc@uk.ac.dl.cxa c or pdc@uk.ac.dl.dlvd c or pdc@uk.ac.liv.ch.xss2 c c last update: January 1991 c c **************************************************************** C * ** c * PLEASE DO NOT REDISTRIBUTE THIS PROGRAM...UP TO DATE COPIES ** C * FREELY AVAILABLE FROM THE AUTHOR ** C * ** C * PLEASE ACKNOWLEDGE ITS USE WHEN PUBLISHING YOUR RESULTS ** C * ** C **************************************************************** C c This utility allows you to plot film images and gnomonic projections c from Laue patterns,cursor in positions,convert between the two and optionally c to output hardcopy plots and dump files suitable for input into NEWLAUE's c autoindex routine. C c It requires the data(unit 1) to be in the form: c RECORD 1 CRYSTAL TO FILM DISTANCE (MM) (FORMAT 1X,F9.3) C RECORDS 2-END XF,YF,(IN MM),INTENSITY,No.RASTERS IN SPOT C (FORMAT 1X,2F9.3,2I6) C The program FILMDSEQ produces files of this type from scanner output files c This program was based on an earlier program by Pella Machin, Daresbury Lab- c oratory C c UNIT 1 = input spot file (filmdseq o/p file) c UNIT 2 = output coordinate file (optional) c UNIT 3 = temporary file for graphics (QGTEMP) c UNIT 4 = output postscript file (optional) c UNIT 5 = standard input c UNIT 6 = standard output c UNIT 0 = standard error c CHARACTER*80 STRING CHARACTER*80 FNAME,FOUT,GNFILE CHARACTER*50 PSFILE CHARACTER*80 DUMPFIL CHARACTER*6 CRYSTAL CHARACTER*24 DATE CHARACTER*20 TITLE CHARACTER*1 IYN,CHAR DIMENSION X(1:50000) DIMENSION Y(1:50000) DIMENSION FF(0:50000) DIMENSION NUM(0:10) DIMENSION XGS(1:100),YGS(1:100),XFS(1:100),YFS(1:100) DIMENSION DELX_MIN(100),DELY_MIN(100) DIMENSION XXF(1:200),YYF(1:200),DDELX(1:200),DDELY(1:200) DIMENSION DDX(1:100),DDY(1:100) INTEGER H,K,L PI=3.14159 PIBY2=PI/2.0 IOP=0 IGP=1 ISYMB=0 IXTERM=0 I=0 C WRITE(*,1000) 1000 FORMAT(' INPUT SPOT FILE NAME:',$) READ(*,1100) FNAME 1100 FORMAT(A) OPEN(UNIT=1,FILE=FNAME,STATUS='OLD') C READ IN CRYSTAL TO FILM DISTANCE READ(1,1200) D 1200 FORMAT(1X,F9.3) C WRITE(*,1400) 1400 FORMAT(' DO YOU WANT TO PRODUCE GNOMONIC PROJECTION [Y]:',$) READ(*,1100)IYN IF(IYN.EQ.'N'.OR.IYN.EQ.'n') THEN IGP=0 GOTO 9 ENDIF C WRITE(*,1250) 1250 FORMAT(' DO YOU WANT OUTPUT OF COORDS AND INTS [N]:',$) READ(*,1100) IYN IF(IYN.EQ.'Y'.OR.IYN.EQ.'y') THEN IOP=1 WRITE(*,1300) 1300 FORMAT(' NAME OF OUTPUT FILE:',$) READ(*,1100) FOUT OPEN(UNIT=2,FILE=FOUT,STATUS='NEW') WRITE(2,1270) 1270 FORMAT('N XF YF XG YG RF RP THETA') C ELSE IOP=0 ENDIF C READ XF YF AND INTENSITY, FIND MAX INTENSITY 9 FFMAX=1 FFSUM=0 10 I=I+1 11 READ(1,950,END=100)XF,YF,NFF,NF 950 FORMAT(1X,2F9.3,2I6) IF (NF.GT.150) GOTO 11 FF(I)=FLOAT(NFF) IF (FF(I).GT.FFMAX) FFMAX=FF(I) FFSUM=FFSUM+FF(I) C IF(IGP.EQ.0) THEN X(I)=XF Y(I)=YF GOTO 10 ENDIF C RF=SQRT(XF**2 + YF**2) IF(RF.LE.1.5) GOTO 11 THETA=0.5*ATAN2(RF,D ) RP=TAN(PIBY2-THETA) c implies origin to projection dist=1.0, c scalefactor for plot will affect this. X(I)=-RP*XF/RF Y(I)=-RP*YF/RF IF(IOP.EQ.1) THEN WRITE(2,900)I,XF,YF,X(I),Y(I),RF,RP,THETA*180/PI ,FF(I) ENDIF 900 FORMAT(I4,2F8.2,2F8.3,3F8.3,F8.1) GOTO 10 C C C 100 XC=100 YC=100 NOBS=I WRITE(6,*) NOBS, ' REFLECTIONS STORED' C CALC DISTRIBUTION OF INTENSITIES DO 65 I=0,10 NUM(I)=0 65 CONTINUE FFMEAN=FFSUM/NOBS DO 70 I=0,NOBS J= 5*FF(I)/FFMEAN IF (J.GT.10) J=10 IF (J.LT.0) J=0 NUM(J)=NUM(J)+1 70 CONTINUE FX=0.2*FFMEAN WRITE(6,960)(FX*N,N=0,10) 960 FORMAT(' FF ',11F8.0) WRITE(6,970)(NUM(I),I=0,10) 970 FORMAT(' N ',11I8) C C WRITE(6,*)' CHOOSE THRESHOLD INTENSITY:' READ(5,*)QTHR IF(IGP.EQ.1)THEN WRITE(6,*)' INPUT ORIGIN TO GNOMONIC PLANE DISTANCE IN MM ' ELSE WRITE(6,*)' INPUT SCALEFACTOR FOR PLOT ' ENDIF READ(5,*)SF WRITE(*,1700) 1700 FORMAT(' INPUT TITLE FOR PLOT(MAX 80 CHARACTERS):') READ(*,1100) STRING WRITE(*,1710) 1710 FORMAT(' DO YOU WANT CHARACTER SIZE PROPORTIONAL TO INT. [N]: ') READ (*,1100)IYN IF (IYN.EQ.'Y'.OR.IYN.EQ.'y') ISYMB=1 WRITE(6,1802) 1802 FORMAT(' IS THIS A UNIX XTERM WINDOW [N]: ') READ (5,1100)IYN if (IYN.EQ.'Y'.OR.IYN.EQ.'y') IXTERM=1 C C START PICTURE CALL QGINIT(3,0,IXTERM,5,6) c c a4 paper actual size = 297 x 210 mm c plotable area (laserjet 3) = 287 x 198 mm RATIO=287.0/198.0 CALL QGMAPC(0.0,1023.0,0.0,1023.0/RATIO,0.0,287.0,0.0,198.0) C WINDOW MAPPED TO A4 LANDSCAPE COORDS IN MM XC=287.0/2.0 YC=198.0/2.0 chsize=12.0 c character size for text(in pixcels) CALL QGENTR CALL QGPSET(2) c start postscript recording C IF(IGP.EQ.1) THEN CALL QGTEXT(2.0,190.0,chsize,'GNOMONIC PROJECTION') ELSE CALL QGTEXT(2.0,190.0,chsize,'OUTPUT FROM GNOM.FOR') ENDIF CALL QGTEXT(65.0,190.0,chsize,STRING) CALL CCPDAT(DATE) CALL QGTEXT(220.0,190.0,chsize,DATE) CALL QGXAX1(XC,YC,90.0,0.0,90.0,0,0,0.0,0.0) CALL QGXAX1(xc-90.0,YC,90.0,-90.0,0.0,0,0,0.0,0.0) CALL QGYAX1(XC,YC-90.0,90.0,-90.0,0.0,0,0,0.0,0.0) CALL QGYAX1(xc,yc,90.0,0.0,90.0,0,0,0.0,0.0) IF(IGP.EQ.1) THEN CALL QGTEXT(XC+92.0,YC,chsize,'XG') CALL QGTEXT(XC,YC+92.0,chsize,'YG') c draw in refernce circle (= origin to plane distance) CALL QGCIRC(XC,YC,SF,0.0,360.0,360) ELSE CALL QGTEXT(XC+92.0,YC,chsize,'XF') CALL QGTEXT(XC,YC+92.0,chsize,'YF') ENDIF IF(IGP.EQ.1) THEN WRITE(STRING,333)SF 333 FORMAT(' ORIGIN TO GP PLANE=',F5.2) CALL QGTEXT(2.0,10.0,chsize,STRING) ELSE WRITE(STRING,334)SF 334 FORMAT(' SCALE FACTOR=',F5.2) CALL QGTEXT(2.0,10.0,chsize,STRING) ENDIF C WRITE(STRING,335)D 335 FORMAT(' CRYSTAL TO FILM DIST=',F6.2) CALL QGTEXT(220.0,10.0,chsize,STRING) C NPLOT=0 DO 110,I=1,NOBS IF(FF(I).LT.QTHR) GOTO 110 J=5*FF(I)/FFMEAN CSIZE=0.2 IF(ISYMB.EQ.0) GOTO 105 IF(J.GE.3) CSIZE=0.4 IF(J.GE.5) CSIZE=0.6 IF(J.GE.8) CSIZE=0.9 105 CONTINUE DX=X(I)*SF DY=Y(I)*SF IF(ABS(DX).LE.100.AND.ABS(DY).LE.100) THEN CALL QGSYMB(DX+XC,DY+YC,5,CSIZE) NPLOT=NPLOT+1 ENDIF 110 CONTINUE C WRITE(STRING,336)NPLOT 336 FORMAT(I6,' POINTS PLOTTED') CALL QGTEXT(75.0,10.0,chsize,STRING) C CALL QGPSET(0) c turn off postscript recording c WRITE(STRING,1410) 1410 FORMAT(' DO YOU WANT TO USE CURSOR FOR SPOT POSITIONS [Y]:') CALL QGTEXT(2.0,6.0,chsize,STRING) READ(*,1100) IYN NCUR=0 IF(IYN.EQ.'N'.OR.IYN.EQ.'n') GOTO 1450 WRITE(STRING,1420) 1420 FORMAT(1X,'TYPE E TO FINISH') CALL QGTEXT(2.0,170.0,chsize*1.5,STRING) 1425 CALL QGCURS(XPOS,YPOS,CHAR) IF(CHAR.EQ.'e'.OR.CHAR.EQ.'E') goto 1450 NCUR=NCUR+1 XCUR=XPOS-XC YCUR=YPOS-YC CALL QGPSET(1) c turn on postscript recording c CALL QGSYMB(XPOS,YPOS,1,4.0) C IF(IGP.EQ.0) GOTO 2000 C XG=XCUR/SF YG=YCUR/SF RP=SQRT(XG**2+YG**2) THETA=PI/2-ATAN(RP) RF=D*TAN(2*THETA) XF=-RF/RP*XG YF=-RF/RP*YG GOTO 2010 C 2000 XF=XCUR/SF YF=YCUR/SF RF=SQRT(XF**2+YF**2) THETA=0.5*ATAN2(RF,D) RP=TAN(PIBY2-THETA) XG=-RP*XF/RF YG=-RP*YF/RF C 2010 XGS(NCUR)=XG YGS(NCUR)=YG XFS(NCUR)=XF YFS(NCUR)=YF GOTO 1425 C 1450 WRITE(STRING,1600) CALL QGPSET(0) 1600 FORMAT(' DO YOU WANT A HARDCOPY PLOT [N]:') CALL QGTEXT(160.0,6.0,chsize,STRING) READ(*,1100) IYN IF(IYN.EQ.'Y'.OR.IYN.EQ.'y') THEN WRITE(STRING,1610) 1610 FORMAT(' NAME OF OUTPUT POSTSCRIPT FILE:') CALL QGTEXT(2.0,2.0,chsize,STRING) READ(*,1100) PSFILE CALL QGTEXT(85.0,2.0,chsize,PSFILE) OPEN(UNIT=4,FILE=PSFILE) CALL QGWRPS(4,1) CALL QGCLR ENDIF C CALL QGCLR CALL QGCLOS C IF(NCUR.GT.0) THEN C WRITE(*,200) WRITE(*,205) 200 FORMAT(1X,'DO YOU WANT TO OUTPUT TRANSLATED', +' CURSOR POSITIONS (C)') 205 FORMAT(1X,'OR NEAREST SPOT FROM INPUT FILE (N) ?[C]:',$) READ(*,1100) IYN IF(IYN.EQ.'N'.OR.IYN.EQ.'n') GOTO 210 C ISPOT=0 DO 1800 I=1,NCUR IF(IGP.EQ.1) WRITE(*,1810) I,XGS(I)*SF,YGS(I)*SF,XFS(I),YFS(I) IF(IGP.EQ.0) WRITE(*,1820) I,XFS(I),YFS(I),XGS(I),YGS(I) 1800 CONTINUE GOTO 305 C 210 ISPOT=1 DO 240 J=1,NCUR REWIND 1 K=0 READ(1,1200) D C C READ IN ALL SPOT POSITIONS BETWEEN XF(J) +AND- 1.0 MM C 220 READ(1,950,END=300)XF,YF,NFF,NF IF(XF.LT.XFS(J)-1.0) GOTO 220 K=K+1 XXF(K)=XF YYF(K)=YF IF(XF.LT.XFS(J)+1.0) GOTO 220 C C FIND NEAREST SPOT C 300 DELSQ_MIN=26.0 LMIN=0 DO 230 L=1,K IF(K.EQ.200)THEN WRITE(*,302) 302 FORMAT(' K=200 ** SEARCH NOT FULLY OVER +/- 1MM **') GOTO 230 ENDIF DDELX(L)=XFS(J)-XXF(L) DDELY(L)=YFS(J)-YYF(L) DELSQ=DDELX(L)**2+DDELY(L)**2 IF(DELSQ.LT.DELSQ_MIN)THEN DELSQ_MIN=DELSQ LMIN=L ENDIF IF(L.EQ.K) THEN IF(LMIN.EQ.0) WRITE(*,235) J DELX_MIN(J)=DDELX(LMIN) DELY_MIN(J)=DDELY(LMIN) DDX(J)=XXF(LMIN) DDY(J)=YYF(LMIN) ENDIF C 230 CONTINUE C LOOPING OVER L C WRITE(*,250)J,DDX(J),DDY(J),DELX_MIN(J),DELY_MIN(J) RF=SQRT(DDX(J)**2+DDY(J)**2) THETA=0.5*ATAN2(RF,D) RP=TAN(PIBY2-THETA) XG=-RP*DDX(J)/RF YG=-RP*DDY(J)/RF WRITE(*,255)XG,YG C 240 CONTINUE C LOOPING OVER J 235 FORMAT(1X,'SPOT',I3,' NO SPOT ON FILM WITHIN 5MM') 250 FORMAT(1X,'SPOT',I3,' XF,YF=',2F6.2,' DEL(X),DEL(Y)=',2F5.2) 255 FORMAT(1X,8X,'XG,YG=',2F6.2,'(SCALE=1.0)') C GOTO 305 C ENDIF C IF(NCUR.EQ.0) GOTO 1830 305 WRITE(*,310) 310 FORMAT(' DO YOU WANT TO OUTPUT A FILE OF CURSORED', +' SPOTS [N]:',$) READ(*,1100)IYN IF(IYN.EQ.'Y'.OR.IYN.EQ.'y') THEN 307 WRITE(*,308) 308 FORMAT(' FOR I/P TO GN3(g) OR NEWLAUE(n) (g/n)? ',$) READ(*,1100)IYN IF(IYN.EQ.'N'.OR.IYN.EQ.'n') GOTO 319 IF(IYN.EQ.'G'.OR.IYN.EQ.'g') GOTO 399 GOTO 307 c gn3 file 399 WRITE(*,400) 400 FORMAT(' NAME OF O/P FILE ? ',$) READ (*,1100) GNFILE OPEN(2,FILE=GNFILE,STATUS='NEW') SCALE=1.0 IF (ISPOT.EQ.1) GOTO 430 C ELSEIF(ISPOT.EQ.0)CONTINUE WRITE(2,*)SCALE DO 410 I=1,NCUR WRITE(2,420) XGS(I),YGS(I) 410 CONTINUE 420 FORMAT(2F8.2) GOTO 450 430 WRITE(2,*) SCALE DO 440 J=1,NCUR RF=SQRT(DDX(J)**2+DDY(J)**2) THETA=0.5*ATAN2(RF,D) RP=TAN(PIBY2-THETA) XG=-RP*DDX(J)/RF YG=-RP*DDY(J)/RF WRITE(2,420) XG,YG 440 CONTINUE 450 GOTO 480 c newlaue .dmp file 319 WRITE(*,320) 320 FORMAT(' NAME OF DUMP FILE ?',$) READ(*,1100) DUMPFIL OPEN(FILE=DUMPFIL,STATUS='NEW',UNIT=2) WRITE(*,330) 330 FORMAT(' INPUT CRYSTAL ID (A6) ',$) READ(*,1100)CRYSTAL WRITE(*,340) 340 FORMAT(' INPUT TITLE (A20) ',$) READ(*,1100) TITLE WRITE(2,350) CRYSTAL,TITLE 350 FORMAT(1X,A6/1X,A20) WRITE(2,360)NCUR 360 FORMAT(' Number=',I4) H=0 K=0 L=0 DO 370 I=1,NCUR IF(ISPOT.EQ.1) WRITE(2,380) H,K,L,DDX(I),DDY(I) IF(ISPOT.EQ.0) WRITE(2,380) H,K,L,XFS(I),YFS(I) 370 CONTINUE CLOSE(2) ENDIF 480 CONTINUE C 380 FORMAT(' h k l ',3i4,t40,'x y ',2F6.1) 1810 FORMAT(1X,'I=',I3,1X,'XG,YG(SCALED)=',2F6.2,1X,'XF,YF=',2F6.2) 1820 FORMAT(1X,'I=',I3,1X,'XF,YF(UNSCALED)=',2F6.2,1X, +'XG,YG(UNSCALED)=',2F6.2) C 1830 WRITE(*,1850) 1850 FORMAT(1X,'STOP') END