Subroutine WRITERAWDATA for program GSAS2CIF

This subroutine is used to copy "raw" data from the GSAS .RAW file for a powder histogram to the output CIF file. See the gsas2cif documentation for an explanation of this code.
link to documentation
      SUBROUTINE WRITERAWDATA(IUEXP,IUCIF,IHST,HTYPE,FIXEDSTEP)

!PURPOSE: Read .RAW powder files and write to CIF -- used only when the 
!         there are more raw data than calc points

      INCLUDE       '../INCLDS/COPYRIGT.FOR' 

!PSEUDOCODE:

!CALLING ARGUMENTS:

      INTEGER*4     IUEXP               !Unit no. for .EXP file
      INTEGER*4     IUCIF               !Unit no. for .CIF file
      INTEGER*4     IHST                !Histogram no. to be read
      CHARACTER*4   HTYPE               !Histogram type
      LOGICAL*4     FIXEDSTEP           ! true for fixed step data

!INCLUDE STATEMENTS:

!LOCAL VARIABLES:

      CHARACTER*12  KEYVAL              !ISAM key
      CHARACTER*66  RAWNAM              !.RAW file name
      INTEGER*4     IURAW               !Unit no. for .RAW file
      CHARACTER*66  INSNAM              !Incident spectrum name
      INTEGER*4     IUINS               !Unit no. for incident spectrum
      LOGICAL*4     NMCHG               !=.TRUE. if a new name was read
      INTEGER*4     ISAM                !ISAM error flag
      INTEGER*4     BANK                !Bank no. requested
      INTEGER*4     NCHANS              !No. of channels written on .Pnn file
      INTEGER*4     MCHANS              !No. of channels from .RAW file
      INTEGER*4     OFFSET              !No. of channels to be skipped
      INTEGER*4     CHKSUM              !Intensity check sum for .RAW data
      REAL*4        YO(90000)           !Observed intensities
!      REAL*4        YI(90000)           !Incident intensities
      REAL*4        YW(90000)           !Variances on YO
!      REAL*4        IW(90000)           !Variances on YI
      REAL*4        TOF(90000)          !Positions
      LOGICAL*4     IERR                !Time map error flag
      REAL*4        TMAX                !Max. TOF or TTH allowed for incident function
      CHARACTER*68  TEXT                !ISAM data string
      CHARACTER*80  ITITL               !Title on raw file
      LOGICAL*4     IXST                !File exist flag
      LOGICAL*4     NEEDESD             ! true if the ESD's are not SQRT(I)

!SUBROUTINES CALLED:

!FUNCTION DEFINITIONS:

      INTEGER*4     READEXP             !ISAM read function
      CHARACTER*6   HSTKEY              !'HST' key maker

!DATA STATEMENTS:

!CODE:

      KEYVAL = HSTKEY(IHST)//' BANK '
      ISAM = READEXP(IUEXP,KEYVAL,TEXT)
      READ(TEXT,'(I5)') BANK
      ISAM = READEXP(IUEXP,KEYVAL(1:6)//' CHANS',TEXT)
      READ(TEXT,'(5I10,I5)') OFFSET,ICLMP,NCHANS,CHKSUM,MCHANS,ISAMP
      IF ( ISAMP.EQ.0 ) ISAMP = 1
      ISAM = READEXP(IUEXP,KEYVAL(1:6)//'  HFIL',TEXT)
      RAWNAM = TEXT(3:68)
      ISAM = READEXP(IUEXP,KEYVAL(1:6)//' NEXC ',TEXT)
      READ (TEXT,'(I5)') NEXC
      WRITE (KEYVAL(7:12),'(A,I3)') 'EXC',NEXC
      ISAM = READEXP(IUEXP,KEYVAL,TEXT)
      READ (TEXT,'(F10.0)') TMAX
      IF ( HTYPE(3:3).EQ.'C' ) THEN
        TMAX = TMAX*100.0
      ELSE IF ( HTYPE(3:3).EQ.'T' ) THEN
        TMAX = TMAX*1000.0
      END IF

      CALL OPNRAW(IURAW,.FALSE.,RAWNAM,NMCHG)               
      READ(IURAW,'(A)',REC=1) ITITL
      CALL READHST(IURAW,BANK,HTYPE,TEXT,MCHANS,TOF,YO,.TRUE.,YW,IERR)
      CLOSE(IURAW)

      LEN=INDEX(RAWNAM,' ')-1
      WRITE(IULST,3) BANK,RAWNAM(1:LEN)
3     FORMAT(' Data for bank ',I2,' read from file ',A)

C at least for right now, ignore the incident spectrum
C Bob, do you want to change this?
!      KEYVAL = KEYVAL(1:6)//'I ITYP'
!      ISAM = READEXP(IUEXP,KEYVAL,TEXT)
!      READ(TEXT,'(I5)') ITYP
!      IF ( ITYP.GE.10 ) THEN
!        ISAM = READEXP(IUEXP,KEYVAL(1:6)//'  MFIL',TEXT)
!        IF ( ISAM.EQ.0 ) THEN
!          INSNAM = TEXT(3:68)
!          INQUIRE(FILE=INSNAM,EXIST=IXST)
!          IF ( IXST ) THEN
!            PRINT '(A,/,1X,A)',' Incident spectrum read from file:',
!     1        INSNAM
!            CALL OPNRAW(IUINS,NEW,INSNAM,NMCHG)               
!            READ(IURAW,'(A)',REC=1) ITITL
!            CALL WRITEXP(IUEXP,KEYVAL(1:6)//'  INAM','  '//ITITL(1:66))      
!            CALL READHST(IUINS,BANK,HTYPE,TEXT,MCHANS,TOF,YI,
!     1        .TRUE.,IW,IERR)
!            CLOSE(IUINS)
!          ELSE
!            PRINT '(A,/,A)',' File '//INSNAM,' not found'
!            STOP 'Error in HSTREAD'
!          END IF
!        END IF
!      END IF

C test to see if SU's can be eliminated since su = sqrt(I)
      NEEDESD = .false.
      DO ICH=1+OFFSET,MCHANS
        IF (YW(ICH) .GT. 0 .AND.
     1    (YO(ICH)/YW(ICH) .LT. .95 .OR. YO(ICH)/YW(ICH) .GT. 1.05))
     1    NEEDESD = .true.
      END DO

      IF (HTYPE(3:3) .eq. 'T') THEN
C     write the detector 2theta angle
        ISAM = READEXP(IUEXP,HSTKEY(IHST)//'BNKPAR',TEXT)
        CALL WRVAL(IUCIF, '_pd_meas_2theta_fixed',TEXT(11:20))
        WRITE(IUCIF,'(/a5,1x,A)') 'loop_', '_pd_meas_time_of_flight'
      ELSE IF (FIXEDSTEP) THEN
        STEP = (TOF(MCHANS) - TOF(1+OFFSET))/(MCHANS-(1+OFFSET))
        CALL FESD(TOF(1+OFFSET)/100., -abs(STEP/10000.), text,ln)
        CALL WRVAL(IUCIF, '_pd_meas_2theta_range_min', text)
        CALL FESD(TOF(MCHANS)/100., -abs(STEP/10000.), text,ln)
        CALL WRVAL(IUCIF, '_pd_meas_2theta_range_max', text)
        CALL FESD(STEP/100., -abs(STEP/10000.), text,ln)
        CALL WRVAL(IUCIF, '_pd_meas_2theta_range_inc', text)
        WRITE(IUCIF,'(/a5,1x,A)') 'loop_'
      ELSE
        WRITE(IUCIF,'(/a5,1x,A)') 'loop_', '_pd_meas_2theta_scan'
      END IF
      WRITE(IUCIF,'(6x,A)') '_pd_meas_intensity_total'
         
      DO ICH=1+OFFSET,MCHANS
        ln = 1
        IF (HTYPE(3:3) .eq. 'T' .OR. .NOT. FIXEDSTEP) THEN
          CALL FESD(TOF(ICH), -TOF(ICH)*.0001, text,ln)
          text(ln+1:) = ' '
          ln = ln + 2
        END IF
        IF (NEEDESD) THEN
          ESD = 0
          IF (YW(ICH) .GT. 0) ESD = SQRT(YW(ICH))
          CALL FESD(YO(ICH), ESD, text(ln:),ln)
        ELSE
          CALL FESD(YO(ICH), -10., text,ln)
        END IF
        write (IUCIF,'(5x,A)') text(:LENCH(text))
      END DO

      write (text,'(I9)') MCHANS-OFFSET
      CALL WRVAL(IUCIF, '_pd_meas_number_of_points', text)
      RETURN
      END