      PROGRAM P3TAPE
C
C         GEORGE T. DE TITTA
C         MEDICAL FOUNDATION OF BUFFALO
C         73 HIGH STREET
C         BUFFALO, NEW YORK 14203, USA
C         TELEPHONE (716) 856-9600
C
C         RUNS INTERACTIVELY.
C
C         DECODES DATA TAPE CONTAINING THETA/TWO-THETA SCAN PROFILE DATA
C         WRITTEN BY THE NICOLET (NEE SYNTEX) P3 DIFFRACTOMETER.
C
C         WRITES A BINARY FILE NAME.RAW CONTAINING THE RAW REFLECTION
C         DATA RECORDS:
C
C         JREF, JH, JK, JL, TWOTH, OMEGA, PHI, CHI, WIDTH, SPEED,
C         BGL, SCAN, BGR, RNET, SIGR, XTIME, JD
C
C             JREF      SERIAL NUMBER
C
C             JH
C             JK        MILLER INDICES
C             JL
C
C             TWOTH
C             OMEGA        EULERIAN
C             PHI       SETTING ANGLES
C             CHI
C
C             WIDTH     SCAN WIDTH (DEGREES OMEGA)
C             SPEED     SCAN SPEED (DEGREES OMEGA PER MINUTE)
C
C             BGL       STATIONARY LEFT BACKGROUND
C             SCAN      TOTAL SCAN COUNT (SUM STEPS 1-96)
C             BGR       STATIONARY RIGHT BACKGROUND
C
C             RNET      NET REFLECTION INTENSITY
C             SIGR      ESD ON COUNTING STATISTICS ALONE
C
C             XTIME     X-RAY EXPOSURE TIME (HOURS)
C
C             JD(96)    ARRAY OF RAW STEP SCAN COUNTS
C
C         JREF IS AN INTEGER*4 WORD; JH, JK, JL, AND JD(96) ARE
C         INTEGER*2 WORDS; AND ALL THE OTHER WORDS ARE REAL.
C
C         JREF IS NEGATIVE FOR STANDARD REFERENCE INTENSITY REFLECTIONS.
C
C         WIDTH IS NEGATIVE IF THE BEAM ATTENUATOR WAS USED.
C
C         RNET = SPEED*(SCAN - RATIO*(BGL + BGR))
C         SIGR = SPEED*SQRT(SCAN + RATIO**2*(BGL + BGR))
C
C         WHERE SPEED IS THE SCAN SPEED FOR THE REFLECTION AND RATIO
C         IS THE RATIO OF THE SCAN TIME TO THE SUM OF THE BACKGROUND
C         COUNTING TIMES.
C
C-------------------------------------------------------------------------------
C
C         PROGRAM P3TAPE CALLS A NUMBER OF MAGNETIC TAPE INPUT-OUTPUT
C         SUBROUTINES THAT MACHINE SPECIFIC.  THESE CALLS ARE:
C
C             CALL ERRSET (64,.TRUE.,.FALSE.,.FALSE.,.TRUE.,31)
C             CALL READMT (IBUF,NBYTE)
C             CALL WAITRW (ISTAT,ICNT)
C             CALL SKPFMT (1)
C             CALL WAITMT (ISTAT,ICNT)
C             CALL CLOSE_MT
C             CALL MTERR (ISTAT)
C
C         PROGRAM P3TAPE ALSO CALLS DECODING SUBROUTINES AS FOLLOWS:
C
C             CALL SPF0 (IBUF( 1),JREF)         
C             CALL SPF1 (IBUF( 5),TWOTH)
C
C         WHERE, E.G., JREF IS AN INTEGER*4 WORD, AND TWOTH IS A REAL
C         WORD.
C
C         LISTINGS AND DESCRIPTIONS OF VAX ASSEMBLY LANGUAGE VERSIONS
C         OF THESE ROUTINES ARE INCLUDED IN THE ACCOMPANYING FILES
C         MAGIO.MAR AND SPFP.MAR.
C         ---------     --------
C-------------------------------------------------------------------------------
C
C         DATA ON THE P3 THETA/TWO-THETA DATA COLLECTION TAPE ARE
C         WRITTEN AS RECORDS OF 248 BYTES (8 BITS PER BYTE), ONE RECORD
C         PER REFLECTION.
C
      PARAMETER (NBYTE=248,NWORD=124)
      INTEGER*2 IBUF(NWORD)
      CHARACTER NAME*40
      INTEGER*2 JH,JK,JL,JD(96)
      TYPE 999
 999  FORMAT('0TYPE IN NAME FOR OUTPUT FILE.  DEV:[DIR.SUB]NAME.RAW')
      ACCEPT 998,NAME
 998  FORMAT(A)
      OPEN(UNIT=1,FILE=NAME,STATUS='NEW',FORM='UNFORMATTED')
C
C         SET ERROR HANDLER FOR INPUT CONVERSION ERRORS SO THAT PROGRAM
C         DOES NOT EXIT ON EOF, EOT, OR PARITY ERROR.
C
      CALL ERRSET(64,.TRUE.,.FALSE.,.FALSE.,.TRUE.,31)
C
C         READ AND DECODE ONE REFLECTION AT A TIME.
C
      NREF=0
 10   IREF=0
 11   CALL READMT(IBUF,NBYTE)
      CALL WAITRW(ISTAT,ICNT)
      IF(ISTAT.EQ.0)GO TO 20
C
C         ISTAT .NE. 0 INDICATES A MAGNETIC TAPE ERROR CONDITION.
C
      CALL MTERR(ISTAT)
      TYPE 997,NREF
 997  FORMAT('0NREF ='I6' REFLECTIONS HAVE BEEN WRITTEN TO THE OUTPUT FI
     1LE.'/'0THE LAST REFLECTION WRITTEN TO THE OUTPUT FILE HAD:')
      TYPE 996,JREF,JH,JK,JL,TWOTH,OMEGA,PHI,CHI,RNET,SIGR,XTIME
 996  FORMAT('      I   H  K  L    2TH     OM     PH     CH       INT
     1       SIG      TIME'/ I7,1X,3I3,4F7.2,2F10.0,F10.2)
 15   TYPE 995
 995  FORMAT('$CONTINUE?  Y OR N.  ')
      ACCEPT 994,ANS
 994  FORMAT(A1)
      IF(ANS.NE.'Y'.AND.ANS.NE.'N')GO TO 15
      IF(ANS.NE.'Y')GO TO 99
      GO TO 10
C
C         DECODE REFLECTION DATA RECORD.
C
 20   CALL SPF0(IBUF( 1),JREF)
      CALL SPF0(IBUF( 2),JH)
      CALL SPF0(IBUF( 3),JK)
      CALL SPF0(IBUF( 4),JL)
      CALL SPF1(IBUF( 5),TWOTH)
      CALL SPF1(IBUF( 7),OMEGA)
      CALL SPF1(IBUF( 9),PHI)
      CALL SPF1(IBUF(11),CHI)
      CALL SPF1(IBUF(13),WIDTH)
      CALL SPF1(IBUF(15),SPEED)
      CALL SPF1(IBUF(17),BGL)
      CALL SPF1(IBUF(19),SCAN)
      CALL SPF1(IBUF(21),BGR)
      CALL SPF1(IBUF(23),RNET)
      CALL SPF1(IBUF(25),SIGR)
      CALL SPF1(IBUF(27),XTIME)
C
C         DECODE STEP COUNTS.
C
      DO 40 J=1,96
      I=J+28
      CALL SPF0(IBUF(I),JD(J))
 40   CONTINUE
      IREF=IREF+1
C
C         CONVERT SCAN WIDTH AND SCAN SPEED FROM UNITS OF DEGREES OF
C         DETECTOR MOTION (TWO-THETA) TO UNITS OF DEGREES OF CRYSTAL
C         ROTATION (OMEGA).
C
      WIDTH=0.5*WIDTH
      SPEED=0.5*SPEED
C
C         CALCULATE BACKGROUND-PEAK-BACKGROUND NET INTENSITY ASSUMING
C         FIRST AND LAST ONE-SIXTH OF SCAN TO BE BACKGROUND AND MIDDLE
C         TWO-THIRDS TO INCLUDE PEAK.
C
      BG1=0
      BG2=0
      DO 45 J=1,16
      BG1=BG1+JD(J)
 45   BG2=BG2+JD(96-J+1)
      PK=0
      DO 46 J=17,80
 46   PK=PK+JD(J)
      RNET=SPEED*(PK-2*(BG1+BG2))
      SIGR=SPEED*SQRT(PK+4*(BG1+BG2))
C
C         THE FIRST REFLECTION IN A FILE.
C
      IF(IREF.GT.1)GO TO 50
      TYPE 993
 993  FORMAT('0FIRST REFLECTION IN THIS FILE HAS:')
      TYPE 996,JREF,JH,JK,JL,TWOTH,OMEGA,PHI,CHI,RNET,SIGR,XTIME
C
C         SKIP THIS FILE?
C
 51   TYPE 992
 992  FORMAT('$SKIP THIS FILE?  Y OR N.  ')
      ACCEPT 994,ANS
      IF(ANS.NE.'Y'.AND.ANS.NE.'N')GO TO 51
      IF(ANS.NE.'Y')GO TO 50
      CALL SKPFMT(1)
      CALL WAITMT(ISTAT,ICNT)
      IF(ISTAT.NE.0)CALL MTERR(ISTAT)
      GO TO 10
 50   CONTINUE
C
C         WRITE REFLECTION RECORD TO OUTPUT FILE.
C
      WRITE(1)JREF,JH,JK,JL,TWOTH,OMEGA,PHI,CHI,WIDTH,SPEED,
     1BGL,SCAN,BGR,RNET,SIGR,XTIME,JD
      NREF=NREF+1
C
C         END OF THE DECODING LOOP.
C
      GO TO 11
C
C         END OUTPUT FILE AND EXIT.
C
 99   ENDFILE 1
      TYPE 997,NREF
      TYPE 996,JREF,JH,JK,JL,TWOTH,OMEGA,PHI,CHI,RNET,SIGR,XTIME
      STOP 'PROGRAM P3TAPE FINIS!'
      END
      SUBROUTINE MTERR (E_CODE)
C
C     MAGTAPE ERROR MESSAGE PROCESSING.
C
      INTEGER*2 MESS_L
      INTEGER*4 E_CODE
      CHARACTER E_MESS*256
      IF(E_CODE.EQ.0)RETURN
      CALL SYS$GETMSG(%VAL(E_CODE),MESS_L,E_MESS,%VAL('F'X),)
      TYPE 100,E_MESS(1:MESS_L)
 100  FORMAT('0',A)
      RETURN
      END
