      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
