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