SUBROUTINE RPLSHD C C PROGRAMMER: R.S. ZHOU C ALFRED UNIVERSITY FEB-1987 C C THIS ROUTINE READS FROM AN X-RAY RIETVELD OUTPUT PLOT C DATA FILE AND WRITES OUT A DATA FILE FOR GRAFIT. C C X-RAY RIETVELD PLOT IS NEW CIRCA-1990 VERSION BY C SCOTT HOWARD, CONVERSION MODIFICATION WRITTEN BY C DAVID MATHEIS C * INCLUDE 'FILECONV.CBS' C================================================================== C C COMMON BLOCKS FOR PROGRAM FILECONV C C================================================================== C C GENERAL BLOCKS... C PARAMETER DTOR= 0.8726646259E-2, RTOD= 114.591559 COMMON /GENRAL/ IREC C C IREC --- READ RECORD POINTER (FOR DEBUGING PURPOSE) C================================================================== C C INPUT/OUTPUT BLOCKS... C PARAMETER IINP= 1, IOUT= 2, NTYP= 60 CHARACTER FILTYP(NTYP)*24 CHARACTER FILINP*32, FILOUT*32 COMMON/IOFILE/IERR,JFIL,IFLI,IFLO,ITYI,ITYO,FILINP,FILOUT,FILTYP C C IERR --- ERROR FLAG: C FROM READ: 0=NO ERROR, 1=ERROR DURING READ, 2=OPEN FAILURE C 3=BAIL OUT C FROM WRITE: 0=NO ERROR, 1=ERROR DURING WRITE OR OPEN FAILURE C 3=BAIL OUT C JFIL ----- FILE TYPE NOT SUPPORTED YET C IFLI ----- INPUT FILE TYPE C IFLO ----- OUTPUT FILE TYPE C ITYI ----- INPUT FILE CATEGORY C 1=RAW, 2=DIF, 3=PLT, 4=DAT C ITYO ----- OUTPUT FILE CATEGORY C 1=RAW, 2=DIF, 3=PLT, 4=DAT C IINP ----- LOGICAL UNIT NUMBER FOR INPUT DATA FILE C IOUT ----- LOGICAL UNIT NUMBER FOR OUTPUT DATA FILE C FILINP --- INPUT DATA FILENAME C FILOUT --- OUTPUT DATA FILENAME C NTYP ----- MAX NUMBER OF FILE TYPES CONVERTABLE C FILTYP --- CHARACTER ARRAY THAT STORES THE FILE TYPE NAME C================================================================== C C FILE HEADER BLOCK... C INTEGER*2 ITYP COMMON /FILHED/ ITYP, NHDB, ISBF, LENG C C ITYP --- DATA FILE TYPE C NHDB --- NUMBER OF RECORDS IN THE HEADER BLOCK C ISBF --- STARTING RECORD OF SPECIFICATION BLOCK REFERENCES C LENG --- LENGTH OF SPECIFICATION BLOCK REFERENCES C================================================================== C C FILE BLOCK REFERENCES... C PARAMETER NSBR= 12 CHARACTER IRLR(NSBR)*4 COMMON /FILRFR/ IRPR(NSBR,2), IRLR C C NSBR --- NUMBER OF SPECIFICATION BLOCK REFERENCES C IRPR --- SPECIFICATION BLOCK REFERENCES (POINTERS AND LENGTH) C IRLR --- LABEL OF SPECIFICATION BLOCK REFERENCES C================================================================== C C FILE DESCRIPTION BLOCK... C INTEGER*2 FTYP, MTYP, NREP, MPRO, NRNG CHARACTER NAME(3)*4, SCAN*1, STYP*1, SLID(20)*4 COMMON /FILDES/ NAME, DATM, TIMM, FTYP, MTYP, NREP, 1 MPRO, NRNG, SCAN, STYP, SLID C C NAME --- OPERATOR NAME C DATM --- ENCODED DATE C TIMM --- ENCODED TIME C FTYP --- FILE TYPE C MTYP --- METHOD OF ANALYSIS C NREP --- NUMBER OF SERIES OF MEASUREMENTS C MPRO --- MEASUREMENT PROCEDURE C NRNG --- NUMBER OF SCAN RANGES C SCAN --- SCAN MODE C STYP --- SERIES TYPE C SLID --- SAMPEL ID C================================================================== C C LINE MEASUREMENT BLOCK... C COMMON /LINEMM/ BANG(14), DANG(14) C C BANG(1) --- STARTING ANGLE C BANG(2) --- ENDING ANGLE C BANG(3) --- STEP WIDTH C BANG(4) --- MAX COUNTS C BANG(5) --- TWO-THETA OF MAX COUNTS C BANG(6) --- MIN COUNTS C BANG(7) --- TWO-THETA OF MIN COUNTS C BANG(8) --- RESERVED C BANG(9) --- NUMBER OF OSCILLATIONS C BANG(10)--- COUNT TIME (SEC) FOR PEAK C BANG(11)--- COUNT TIME FOR BACKGROUND C BANG(12)--- RESERVED C BANG(13)--- DELAY TIME C BANG(14)--- FIXED ANGLE OF MEASUREMENT C DANG(*) --- USER MODIFIABLE SET OF BANG(*) C================================================================== C C INSTRUMENTATION BLOCK... C CHARACTER ANODE(6)*2 COMMON /INSTRU/ IELE, WAVE(5,6), ANODE C C IELE -------- TARGET ELEMENT (DEFAULT=4,Cu) C WAVE(*,1) --- Cr C WAVE(*,2) --- Fe C WAVE(*,3) --- Co C WAVE(*,4) --- Cu C WAVE(*,5) --- Mo C WAVE(*,6) --- USER SPECIFIED C WAVE(1,*) --- WAVELENGTH OF K-ALPHA 1 C WAVE(2,*) --- WAVELENGTH OF K-ALPHA 2 C WAVE(3,*) --- WAVELENGTH OF K-ALPHA C WAVE(4,*) --- WAVELENGTH OF K-BETA C WAVE(5,*) --- KA1/KA2 RATIO C================================================================== C C INTENSITY DATA BLOCK... C PARAMETER MNP= 10000 REAL*4 YOBS(MNP) COMMON /COUNTS/ MODE, NPTS, XOBS(MNP), YOBS C C MNP ---- MAXIMUM NUMBER OF DATA POINTS ALLOWED C MODE --- 0 = X --- TWO-THETA C 1 = X --- D-SPACING C 2 = X --- Q-SCAN (Q=2PI/D=4PI*SIN(THETA)/LAMDA) C NPTS --- TOTAL NUMBER OF DATA POINTS STORED IN YOBS C XOBS --- ARRAY TO STORE THE X-VALUES C YOBS --- ARRAY TO STORE THE RAW COUNTS C================================================================== C C DIFILE BLOCK... C PARAMETER MNK= 500 CHARACTER PEAK(MNK)*4 INTEGER*4 PHKL(3,MNK) COMMON /DIFILE/ NPKS, IRES, JRES, CUTI(2), CUTF(2), 1 F2TH(MNK), FDSP(MNK), C2TH(MNK), CDSP(MNK), 1 PHGH(MNK), AREA(MNK,2), RELA(MNK), 1 FWHM(MNK), PHKL, PEAK C C MNK ---- MAXIMUM NUMBER OF PEAKS ALLOWED C NPKS --- TOTAL NUMBER OF PEAKS STORED C IRES --- RESIDUAL PATTERN FLAG: 0=CONTAINED, 1=NOT CONTAINED C JRES --- USE THE RESIDUAL PATTERN: 1=NO, 2=YES C CUTI --- INTENSITY CUTOFFS (%) C CUTF --- FWHM CUTOFFS (D) C F2TH --- OBSERVED TWO-THETA C FDSP --- OBSERVED D-SPACING C C2TH --- CORRECTED TWO-THETA C CDSP --- CORRECTED D-SPACING C PHGH --- PEAK HEIGHT (CPS) C AREA(*,1) --- INTEGRATED INTENSITY C AREA(*,2) --- RESIDUAL INTENSITY C RELA --- RELATIVE INTENSITY C FWHM --- FULL WIDTH AT HALF MAXIMUM C PHKL --- REFLECTION HKL C PEAK --- PEAK TYPE LABEL C================================================================== CHARACTER qtext*78, FILPAR*32, title*80, qdgttl(10)*28 character qntitl*20 DIMENSION kdgfrq(10), pdgofs(10), kdgpen(10), 1 kdgtyp(10), pdginc(10), kdgusd(10), pdglxy(10,3), 2 xdata(7500,10), ydata(7500,10), PDVVL2(999,10), KDVIV1(999,10), 3 PDVXVL(999,10),PDVYVL(999,10),PDVVL1(999,10), ndpts(10) CALL COLORS(-1) CALL putext('Writing the output file... Please wait...',41,24,1) C============================================================== C TRY TO OPEN THE INPUT FILE AS AN UNFORMATTED FILE FIRST... C============================================================== CLOSE( UNIT=IINP ) OPEN(IINP, FILE=FILINP, STATUS='OLD', 1 FORM='UNFORMATTED', ERR=888 ) C C READ THE file header... C READ(IINP,err=1111,end=777) qtext READ(IINP,ERR=1111,END=777) title READ(IINP,ERR=1111,END=777) xscale, jaxbox, jaxdrw READ(IINP,ERR=1111,END=777) jxaxid, xaxor, xaxln, 1 xaxst, xaxen, xaxdv READ(IINP,ERR=1111,END=777) jyaxid, yaxor, yaxln, 1 yaxst, yaxen, yaxdv READ(IINP,ERR=1111,END=777) knum print*,'knum is: ',knum * C * GET THE GROUP PARAMETERS * DO I=1,KNUM READ(IInp) QNTITL,I1,X1,I2,I3,X2 QDGTTL(I) = QNTITL KDGFRQ(I) = I1 PDGOFS(I) = X1 KDGPEN(I) = I2 KDGTYP(I) = I3 PDGINC(I) = X2 KDGUSD(I) = 0 PDGLXY(I,1) = 0.0 PDGLXY(I,2) = 0.0 PDGLXY(I,3) = 0.0 enddo * knum = 7 * ** READ THE DATA SETS * nnset = 0 100 READ(IInp,END=1) NSET,NDVPTS,PDVBEG nnset = nnset + 1 WRITE(6,12) nNSET,NDVPTS,kdgtyp(nnset),pdvbeg 12 FORMAT(' Reading data for group ',I2,'. Number of points = ',I10, */,'data type: ',i3,' and pdvbeg: ',f10.3) ndpts(nnset) = ndvpts C * C ** READ TYPE 0 DATA, PLOTTING DATA SET C * IF(KDGTYP(nnset).NE.0) GO TO 200 NREC = ndvpts / 10 NREM = NDVPTS - NREC * 10 NTRK = 0 DO I=1,NREC READ(iinp,END=1) ( ydata(J,nnset), J=(NTRK+1),(NTRK+10) ) NTRK = NTRK + 10 enddo IF(NREM.GT.0) THEN READ(iinp,END=1) ( ydata(J,nnset), J=(NTRK+1),(NTRK+NREM) ) ENDIF do i=1,ndvpts xdata(i,nnset) = pdvbeg + (i-1) * pdginc(nset) enddo GO TO 100 C * C ** READ TYPE 1 = X-Y DATA C * 200 IF(KDGTYP(nnset).NE.1) GO TO 300 DO I=1,NDVPTS READ(iinp,END=1) xdata(I,nnset),ydata(I,nnset) enddo GO TO 100 C * C ** READ TYPE 2 DATA = MARKER INFORMATION C * 300 IF(KDGTYP(nnset).NE.2) GO TO 400 DO I=1,NDVPTS READ(iinp,END=1) PDVXVL(i,nnset),PDVYVL(i,nnset), 1 PDVVL1(i,nnset),PDVVL2(i,nnset),KDVIV1(i,nnset) enddo GO TO 100 C * C ** READ TYPE 3 DATA = VERTICAL ERROR BARS C * 400 IF(KDGTYP(nnset).NE.3) GO TO 500 DO I=1,NDVPTS READ(iinp,END=1) PDVXVL(i,nnset),PDVYVL(i,nnset), * PDVVL1(i,nnset) enddo GO TO 100 C * C ** READ TYPE 4 DATA = HORIZONTAL ERROR BARS C * 500 IF(KDGTYP(nnset).NE.4) GO TO 777 DO I=1,NDVPTS READ(iinp,END=1) PDVXVL(i,nnset),PDVYVL(i,nnset), * PDVVL1(i,nnset) enddo GO TO 100 C====================================================== C OPEN THE INPUT FILE AS A FORMATTED FILE NEXT... C====================================================== 1111 CLOSE( UNIT=IINP ) OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD', READONLY, 1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=888 ) C C READ THE TITLE... C READ(IINP,3000,ERR=777,END=777) qtext 3000 FORMAT(A) READ(IINP,3000,ERR=777,END=777) title READ(IINP,3010,ERR=777,END=777) xscale, jaxbox, jaxdrw 3010 format(f9.4,i9,i9) READ(IINP,3001,ERR=777,END=777) jxaxid, xaxor, xaxln, 1 xaxst, xaxen, xaxdv 3001 FORMAT(i9,5f9.4) READ(IINP,3001,ERR=777,END=777) jyaxid, yaxor, yaxln, 1 yaxst, yaxen, yaxdv READ(IINP,3002,ERR=777,END=777) knum 3002 FORMAT(I9) DO I=1, knum READ(IINP,3003,ERR=777,END=777) qdgttl(I), kdgfrq(I), 1 pdgofs(I), kdgpen(i), kdgtyp(i), pdginc(i) ENDDO 3003 FORMAT(A28,i1,f9.2,2i9,F9.4) C C READ THE DATA RECORDS... C 2225 READ(IINP,3004,ERR=777,END=1) nset, ndvpts, pdvbeg 3004 FORMAT(2I6,F10.4) IF( kdgtyp(Nset).NE.0 ) GOTO 3333 ndpts(nset) = ndvpts C C INTENSITY DATA FOLLOW... C READ(IINP,3005,ERR=777,END=1) (Ydata(I,nset),I=1, Ndvpts) 3005 FORMAT(10F8.1) DO I=1, ndvpts Xdata(I,nset) = pdvbeg + (I-1) * pdginc(nset) ENDDO GOTO 2225 3333 IF( kdgtyp(Nset).NE.1 ) GOTO 4444 C C GENERL X,Y PAIR DATA FOLLOW... C READ(IINP,3006,ERR=777,END=1) (Xdata(I,nset),Ydata(I,nset), 1 I=1, Ndvpts) 3006 FORMAT(2F10.4) GOTO 2225 4444 IF( kdgtyp(nset).NE.2 ) GOTO 777 C C REFLECTION MARKER INFORMATION FOLLOWS... C READ(IINP,3007,ERR=777,END=1) PDVXVL(i,nset),PDVYVL(i,nset), 1 PDVVL1(i,nset),PDVVL2(i,nset),KDVIV1(i,nset) 3007 FORMAT(4F10.4,I2) goto 2225 C================================================================ C OPEN THE PARAMETER FILE... C================================================================ 1 knum = nnset CALL NAMEXT( FILOUT, FILPAR, 'PAR' ) CLOSE( UNIT=13 ) OPEN( UNIT=13, FILE=FILPAR, STATUS='UNKNOWN', 1 CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 ) XAXDV = (XAXEN - XAXST)/5.0 WRITE(13,1000,ERR=666) title, xaxst, xaxen, xaxdv, FILOUT 1000 FORMAT('%This is a GRAFIT parameter/setup file: '/ 1 'TITL= ',a/ 2 'XLB1=TWO-THETA (DEGREES)'/ 3 'YLB1=INTENSITY (CPS)'/ A 'XLB2='/ B 'YLB2='/ 4 'OVER= 2 1 0 1 1 1 4.000 4.500 1.250 5 1.200 0.000 0.000 1.000 1.000'/ C 'XAX1= 1 5 1 0 11 8.000 0.000 0.000 0.000' C ,f8.5,3x,f10.5,3x,f6.3/ D 'YAX1= 1 4 1 0 11 6.000'/ 6 'PAR1= 1.00 1.00 1.00 1.00 0.00 0.00 1.00 7 1.00 1.00 0.00'/ 8 'PAR2= 5.00 1.00 1.00 0.00 0.00 0.00 0.00 9 0.00 0.00 0.00'/ E 'IDEN=',A32) * * WRITE LABELS TO PARAMETER FILE * do i=1,knum YOFF = 0.0 IPN = i + 1 IF(qdgttl(i).EQ.'Observed pattern')THEN YOFF = 0.5 ENDIF IF(qdgttl(i).EQ.'Calculated pattern')THEN YOFF = -0.5 ENDIF IF(qdgttl(i).EQ.'Background')THEN YOFF = -0.6 ENDIF IF(qdgttl(i).EQ.'Difference pattern')THEN YOFF = 0.0 ENDIF if(kdgtyp(i).eq.0)then WRITE(13,1101,ERR=666)IPN,YOFF,qdgttl(i) endif 1101 FORMAT('SETS=',I4,' 0 1 3 1 1 0 0.100 0.000', 1 F8.3,' 1.0000 1.0000 0.00000E+00'/ 2 'LABL=',A28) enddo * C==================================================================== C OPEN THE OUTPUT FILE... C==================================================================== 900 CLOSE( UNIT=IOUT ) OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW', 1 FORM='FORMATTED', carriagecontrol='list', ERR=666 ) * * do i=1,knum * if(ndpts(i).eq.0)goto 910 * WRITE(IOUT,ERR=666) Ndpts(i) * WRITE(IOUT,ERR=666) ( Xdata(j,I), j=1, Ndpts(i) ) * WRITE(IOUT,ERR=666) ( Ydata(j,I), j=1, Ndpts(i) ) * 910 enddo do i=1,knum if(kdgtyp(i).eq.0)then if(ndpts(i).eq.0)goto 910 WRITE(IOUT,912,ERR=666) Ndpts(i) do j=1,ndpts(i) WRITE(IOUT,911,ERR=666)Xdata(j,I), Ydata(j,I) enddo endif 910 enddo 911 format(2f8.2) 912 format(i5) go to 999 * 777 IERR = 1 GOTO 999 666 IERR = -1 GOTO 999 888 IERR = 2 999 CLOSE( UNIT=13 ) CLOSE(UNIT=Iinp) CLOSE(UNIT=IOUT) RETURN END