PROGRAM CAD4ASCII
C
C         ROBERT H. BLESSING
C         MEDICAL FOUNDATION OF BUFFALO
C         73 HIGH STREET
C         BUFFALO, NEW YORK 14203, USA
C         TELEPHONE (716) 856-9600
C
C         JULY 1992.  MODIFIED FOR FORMAT (12I5) FOR BARCELONA STEP SCAN
C         RECORD TYPES 3, 4,..., 9, 9.
C
C         AUGUST 1985
C
C         RUNS INTERACTIVELY.
C
C         DECODES A FILE CONTAINING THETA/TWO-THETA OR OMEGA SCAN
C         PROFILE DATA WRITTEN BY THE ENRAF-NONIUS CAD4 DIFFRACTOMETER.
C
C         WRITES A BINARY FILE NAME.RAW CONTAINING THE RAW REFLECTION
C         DATA RECORDS:
C
C             JREF      SERIAL NUMBER
C
C             JH
C             JK        MILLER INDICES
C             JL
C
C             THETA
C             PHIK      DIFFRACTOMETER
C             OMEGAK    SETTING ANGLES
C             KAPPA
C
C             WIDTH     SCAN WIDTH (DEGREES OMEGA)
C             SPEED     SCAN SPEED (DEGREES OMEGA PER MINUTE)
C
C             BGL       LEFT BACKGROUND  (SUM STEPS  1-16)
C             PK        PEAK             (SUM STEPS 17-80)
C             BGR       RIGHT BACKGROUND (SUM STEPS 81-96)
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*(PK - 2*(BGL + BGR))
C         SIGR = SPEED*(SQRT(PK + 4*(BGL + BGR)))
C
C         NOTE THAT RNET AND SIGR AS READ FROM THE DIFFRACTOMETER TAPE
C         ARE RNET/SPEED AND SIGR/SPEED, WHICH ARE NOT NORMALIZED TO
C         ACCOUNT FOR VARIABLE SCAN SPEEDS OR FOR THE BEAM ATTENUATOR
C         FACTOR.
C
C-------------------------------------------------------------------------------
C
C         DATA ON CAD4 MAGNETIC TAPE ARE ORGANIZED IN 64-BYTE RECORDS.
C
C         BYTE 1 IS A LINE FEED CHARACTER; BYTE 64 IS A CARRIAGE RETURN
C         CHARACTER.
C
C         64 BYTES PER RECORD
C
C         8 BITS PER BYTE
C         1 BYTE PER ASCII CHARACTER
C         2 CHARACTERS PER INTEGER*2 WORD
C
      PARAMETER (NBYTE=64)
      CHARACTER CHAR(NBYTE)*1
C-------------------------------------------------------------------------------
      REAL KAPPA
      CHARACTER INFILE*40,OUTFILE*40
      INTEGER*2 JH,JK,JL,JD(96),JT
      DIMENSION ACODE(6)
      TYPE 999
 999  FORMAT ('0TYPE IN NAME FOR INPUT FILE.  DEV:[DIR.SUB]NAME.RAW')
      ACCEPT 998,INFILE
 998  FORMAT (A)
      TYPE 997
 997  FORMAT ('0TYPE IN NAME FOR OUTPUT FILE.  DEV:[DIR.SUB]NAME.RAW')
      ACCEPT 998,OUTFILE
      OPEN (UNIT=1,FILE=INFILE,STATUS='OLD',FORM='FORMATTED')
      OPEN (UNIT=2,FILE=OUTFILE,STATUS='NEW',FORM='UNFORMATTED')
      NREF=0
 1    READ (1,100,END=9) X,CHAR
 100  FORMAT (A1,64A)
C
C         DETERMINE RECORD TYPE.
C
      JTYPE=0
      DECODE (1,9400,CHAR(1),ERR=1) JTYPE            
 9400 FORMAT (I1)
      IF (3.LE.JTYPE.AND.JTYPE.LE.9) GO TO 403
      DECODE (2,1400,CHAR(2),ERR=1) JTYPE
 1400 FORMAT (I2)
      IF (JTYPE.EQ.1) GO TO 401
      IF (JTYPE.EQ.2) GO TO 402
      GO TO 1
C
C     TYPE 1 RECORD
C
  401 DECODE (58,1401,CHAR(4),ERR=1) JREF,JH,JK,JL,(ACODE(J),J=1,
     & 6),PSI,NPI,JBGL,JPK,JBGR
 1401 FORMAT (I6,3I5,1X,6A1,F7.2,I4,I6,I7,I6)
      GO TO 1
C
C     TYPE 2 RECORD
C
  402 DECODE (58,1402,CHAR(4),ERR=1) JREF,THETA,PHIK,OMEGAK,KAPPA,
     & WIDTH,JXTIME,JFRIDL
 1402 FORMAT (I6,F8.3,3F9.3,F7.3,I7,I3)
      GO TO 1
C
C     TYPES 3 TO 10 RECORDS
C
  403 IF (JTYPE.EQ.9) THEN
C
C       HANDLE SINGLE DIGIT RECORD TYPE NOS. 3, 4,..., 9, 9.
C
        DATA J9 /0/
        JTYPE=JTYPE+J9
        J9=MOD(J9+1,2)
      END IF
      N=12*(JTYPE-2)
      M=N-11
      DECODE (60,1403,CHAR(2),ERR=1) (JD(J),J=M,N)
 1403 FORMAT (12I5)
      IF (N.LT.96) GO TO 1
C
C         RECORDS FOR ONE ENTIRE REFLECTION ARE DECODED.
C
      NREF=NREF+1
C
C         FLAG STANDARD REFERENCE INTENSITY REFLECTIONS BY SETTING THEIR
C         SERIAL NUMBER NEGATIVE.
C
      IF (ACODE(1).EQ.'I') JREF=-JREF
C
C         ESTIMATE NET INTEGRATED INTENSITY.
C
      BGL=JBGL
      PK=JPK
      BGR=JBGR
      RNET=PK-2*(BGL+BGR)
      VARR=PK+4*(BGL+BGR)
      SIGR=SQRT(VARR)
C
C         EVALUATE SCAN SPEED.
C
      SPEED=20.1166/NPI
C
C         NEGATIVE SCAN SPEED IS A FLAG THAT THE BEAM ATTENUATOR WAS
C         USED.  NEGATIVE WIDTH IS A FLAG THAT THE SCAN WAS DONE IN
C         NEGATIVE, I.E., POSITIVE TO NEGATIVE, DIRECTION.  (NOTE,
C         HOWEVER, THAT THE PROFILE IS ALWAYS WRITTEN IN THE POSITIVE,
C         I.E., NEGATIVE TO POSITIVE, DIRECTION.)
C
C         TRANSFER ATTENUATOR FLAG FROM SCAN SPEED TO SCAN WIDTH.
C
      WIDTH=ABS(WIDTH)
      IF (SPEED.GE.0.0) GO TO 60
      SPEED=-SPEED
      WIDTH=-WIDTH
  60  CONTINUE
C
C         NORMALIZE NET INTENSITY FOR VARIABLE SCAN SPEED.
C
      RNET=SPEED*RNET
      SIGR=SPEED*SIGR
C
C         CONVERT X-RAY EXPOSURE TIME FROM SECONDS TO HOURS.
C
      XTIME=JXTIME/3600.
C
C         REVERSE ORDER OF PROFILE ARRAY FOR REFLECTIONS MEASURED AT
C         NEGATIVE TWO-THETA.
C
      IF (THETA.LT.0) THEN
      DO 5 J=1,48
      K=96-J+1
      JT=JD(J)
      JD(J)=JD(K)
 5    JD(K)=JT
      END IF
C
C         REVERSE SIGNS OF INDICES FOR PSI SCAN REFLECTIONS MEASURED AS
C         FRIEDEL EQUIVALENTS BUT AT NEGATIVE TWO-THETA.
C
      IF (PSI.NE.0.AND.THETA.LT.0.AND.JFRIDL.LT.0) THEN
      JH=-JH
      JK=-JK
      JL=-JL
      END IF
C
C         WRITE REFLECTION RECORD TO OUTPUT FILE.
C
      WRITE (2) JREF,JH,JK,JL,THETA,PHIK,OMEGAK,KAPPA,WIDTH,SPEED,
     & BGL,PK,BGR,RNET,SIGR,XTIME,JD
      GO TO 1
 9    CONTINUE
C
C         END OUTPUT FILE AND EXIT.
C
      ENDFILE 2
      TYPE 990,NREF
 990  FORMAT ('0NREF = 'I5' REFLECTIONS TRANSFERRED TO OUTPUT FILE')
      STOP 'PROGRAM CAD4TAPE FINIS!'
      END