C *** PROGRAM: RRXRD - REFORMAT X-RAY DATA C *** VERSION: 891225 C *** AUTHOR : S.A. HOWARD, UNIV. OF MO.- ROLLA C * PARAMETER ( KVERSN=891225 ) CHARACTER QOPT*1 C * C ** DETERMINE THE FORMATTING OPERATION TO PERFORM C * 1000 WRITE(6,1010) KVERSN 1010 FORMAT(' RRXRD - Reformat X-ray pattern files. V ',I6) WRITE(6,1020) 1020 FORMAT(/, 1 ' Choose formatting option :',//, 1 ' 1 - Change FORMATTED to UNFORMATTED data',/, 1 ' 2 - Change UNFORMATTED to FORMATTED data',//, 1 ' Option ? ') READ(5,1030) QOPT 1030 FORMAT(A1) C * C * PERFORM THE FORMATTING 2000 IF(QOPT.EQ.'1') CALL ASCBIN IF(QOPT.EQ.'2') CALL BINASC C * 9000 STOP '* Normal termination of RRXRD *' END C *** DATE - PC DATE ROUTINE C * LIMIT TO 9 CHARACTERS. USED ONLY AS A TIME STAMP. C * C SUBROUTINE DATE( QDATE ) C CHARACTER QDATE*9 C INTEGER*2 IYEAR,IMONTH,IDAY C CHARACTER QMONTH(12)*3 C DATA QMONTH/ 'Jan','Feb','Mar','Apr','May','Jun', C 1 'Jun','Aug','Sep','Oct','Nov','Dec'/ C CALL GETDAT( IYEAR, IMONTH, IDAY ) C IYEAR = IYEAR - 1900 C WRITE(QDATE,1) IDAY,IYEAR C1 FORMAT(I2,'-',3X,'-',I2) C QDATE(4:6) = QMONTH(IMONTH) C RETURN C END C *** TIME - PC TIME ROUTINE C * LIMIT TO 8 CHARACTERS. USED ONLY AS A TIME STAMP. C * C SUBROUTINE TIME( QTIME ) C CHARACTER QTIME*8 C INTEGER*2 IH,IM,IS,IHS C CALL GETTIM( IH, IM, IS, IHS ) C WRITE(QTIME,1) IH,IM,IS C1 FORMAT(I2,':',I2,':',I2) C RETURN C END C *** ASCBIN - REFORMAT STANDARD FORMATTED TO UNFORMATTED C * SUBROUTINE ASCBIN C * CHARACTER QTITLE*80,QFILE*40,QTYPE*1,QDATE*9,QTIME*8 PARAMETER ( MNPTS = 15360, MAXREC = MNPTS / 10 ) COMMON/XRDDAT/ XDATA(MNPTS) DIMENSION EXTRA(4) C * C * GET THE FILE NAMES C * 1000 WRITE(6,1020) 1020 FORMAT(/,' Input file name ? ') READ(5,1030) QFILE 1030 FORMAT(A40) OPEN(UNIT=10,FILE=QFILE,STATUS='OLD',ERR=1090) WRITE(6,1040) 1040 FORMAT(' Output file name ? ') READ(5,1030) QFILE OPEN(UNIT=20,FILE=QFILE,FORM='UNFORMATTED',STATUS='UNKNOWN', 1ERR=1092) GO TO 1100 1090 STOP '--Input file is busy or not there' 1092 STOP '--Error opening output file' C * C ** READ FORMATTED DATA AND WRITE INTO UNFORMATTED C * C * READ THE FILE HEADER 1100 READ(10,1110) QTITLE 1110 FORMAT(A80) READ(10,1120) QDATE,QTIME 1120 FORMAT(A9,A8) READ(10,1130) SA,EA,AI,CT,EXTRA 1130 FORMAT(8F10.4) WRITE(6,1140) QTITLE(1:72),QDATE,QTIME,SA,EA,AI,CT 1140 FORMAT(' Input file id:',/,1X,A72,/,' Date and time of run: ',A9, 1 1X,A8,/,' Angle start, end, inc, count time = ',4F10.4) C * 1200 DO 1210 I=1,MAXREC IS = (I-1) * 10 + 1 IE = IS + 9 READ(10,1220,END=1300) (XDATA(J),J=IS,IE) 1220 FORMAT(10F7.0) 1210 CONTINUE WRITE(6,1230) 1230 FORMAT(/,' ** MAX NUMBER OF RECORDS READ BEFORE EOF HIT:', 1' DATA POSSIBLY INCOMPLETE') I = MAXREC + 1 C * C * CALCULATE ENDING ANGLE 1300 NREC = I - 1 WRITE(6,1310) NREC 1310 FORMAT(/,' Number of data records read = ',I5) ANGE = SA + REAL(NREC) * 10.0 * AI - AI WRITE(6,1320) EA,ANGE 1320 FORMAT( 1' File ending angle: ',F8.4,' Max based on file records ',F8.4) EA = AMIN1( EA, ANGE ) C * C * WRITE THE HEADER 1400 WRITE(20) QTITLE WRITE(20) QDATE,QTIME WRITE(20) SA,EA,AI,CT,EXTRA DO 1410 I=1,NREC IS = (I-1) * 10 + 1 IE = IS + 9 WRITE(20) (XDATA(J),J=IS,IE) 1410 CONTINUE C * 1500 CLOSE(UNIT=10) CLOSE(UNIT=20) WRITE(6,1510) NREC 1510 FORMAT( ' Number of data records rewritten = ',I5) C * 9000 RETURN END C *** BINASC - REFORMAT STANDARD UNFORMATTED TO FORMATTED C * SUBROUTINE BINASC C * CHARACTER QTITLE*80,QFILE*40,QTYPE*1,QDATE*9,QTIME*8 PARAMETER ( MNPTS = 15360, MAXREC = MNPTS / 10 ) COMMON/XRDDAT/ XDATA(MNPTS) DIMENSION EXTRA(4) C * C * GET THE FILE NAMES C * 1000 WRITE(6,1020) 1020 FORMAT(/,' Input file name ? ') READ(5,1030) QFILE 1030 FORMAT(A40) OPEN(UNIT=10,FILE=QFILE,FORM='UNFORMATTED',STATUS='OLD', 1ERR=1900) WRITE(6,1040) 1040 FORMAT(' Output file name ? ') READ(5,1030) QFILE OPEN(UNIT=20,FILE=QFILE,FORM='FORMATTED',STATUS='UNKNOWN', 1ERR=1910) GO TO 1100 1900 STOP '--Input file is busy or not there' 1910 STOP '--Error opening output file' C * C ** READ UNFORMATTED DATA AND WRITE INTO FORMATTED C * C * READ THE FILE HEADER 1100 READ(10) QTITLE READ(10) QDATE,QTIME READ(10,ERR=1110) SA,EA,AI,CT,EXTRA GO TO 1130 1110 BACKSPACE(10) READ(10) SA,EA,AI,CT EXTRA(1) = 0.0 EXTRA(2) = 0.0 EXTRA(3) = 0.0 EXTRA(4) = 0.0 WRITE(6,1120) 1120 FORMAT(/, 1' -Old file format converted to new with record 3:',/, 1' Start_angle, End_angle, Angle_inc, Count_time, Extra 1-4',/) 1130 WRITE(6,1140) QTITLE(1:72),QDATE,QTIME,SA,EA,AI,CT 1140 FORMAT(' Input file id:',/,1X,A72,/,' Date and time of run: ',A9, 1 1X,A8,/,' Angle start, end, inc, count time = ',4F10.4) C * 1200 DO 1210 I=1,MAXREC IS = (I-1) * 10 + 1 IE = IS + 9 READ(10,END=1300) (XDATA(J),J=IS,IE) 1210 CONTINUE WRITE(6,1220) 1220 FORMAT(/,' ** MAX NUMBER OF RECORDS READ BEFORE EOF HIT:', 1' DATA POSSIBLY INCOMPLETE') I = MAXREC + 1 C * 1300 NREC = I - 1 WRITE(6,1310) NREC 1310 FORMAT(/,' Number of data records read = ',I5) ANGE = SA + REAL(NREC) * 10.0 * AI - AI WRITE(6,1320) EA,ANGE 1320 FORMAT( 1' File ending angle: ',F8.4,' Max based on file records ',F8.4) EA = AMIN1( EA, ANGE ) C * C * WRITE THE HEADER 1400 WRITE(20,1410) QTITLE(1:78) 1410 FORMAT(A78) WRITE(20,1420) QDATE,QTIME 1420 FORMAT(A9,A8) WRITE(20,1430) SA,EA,AI,CT,EXTRA 1430 FORMAT(8F10.4) DO 1440 I=1,NREC IS = (I-1) * 10 + 1 IE = IS + 9 WRITE(20,1450) (NINT(XDATA(J)),J=IS,IE) 1450 FORMAT(10I7) 1440 CONTINUE C * 1500 CLOSE(UNIT=10) CLOSE(UNIT=20) WRITE(6,1510) NREC 1510 FORMAT( ' Number of data records rewritten = ',I5) C * 9000 RETURN END