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.
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