C********************************************************************** C SUBROUTINE QBEGIN( IQUIT) C C SET UP FOR A QUANTITATIVE DATA COLLECTION RUN C C OPEN THE RUN AND RAW FILES C ASK ANY LAST MINUTE QUESTIONS (or get them from old version of RAW) C READ THE CALIBRATION FILE FOR THE DIFFRACTOMETER. C INITIALIZE THE INTERFACE C C If the user types control Z in response to any question; this routine C will set IQUIT to nonzero and return to main. C C===================================================================== C C THE "QUANT" DATA COLLECTION PACKAGE ALLOWS FOR FIVE MODES OF C DATA COLLECTION. THREE ARE FOR QUANTITATIVE ANALYSIS AND TWO C ARE FOR SELECTED AREA DATA COLLECTION. THEY ARE: C C INTERNAL STANDARD METHOD (IFLAG(3) = 1) C INTENSITY RATIO METHOD (IFLAG(3) = 2) C SPIKING METHOD (IFLAG(3) = 3) C PEAK AND INTEGRATED INT. (IFLAG(3) = 4) C CALIBRATION AND PROFILE (IFLAG(3) = 5) C C NOTE: INTENSITY AND CALIBRATION DATA COLLECTION ARE IDENTICAL. C THE DIFFERENT IFLAG VALUES ARE ONLY FOR PURPOSES OF ANALYSIS C OF THE RAW DATA. GENERALLY THE PEAK AND INTEGRATED INTENSITY C MODE WILL USED FOR DETERMINATION OF RELATIVE INTENSITIES. C C===================================================================== C INCLUDE 'COMMON.FTN' C Uses IRD, ITYP, IRUN, IRAW of /IO/ C Uses CNT of /ARRAY/ C Uses PANG, PKTIM, BKGTIM, IPKFND, LPEAK of /PKCMN/ C Uses CONC, SCONC, NREC, NREP, NMOUNT of /RUN/ C Uses TITLE, USER, NMRUN, NMRAW, IFLAG of /LOG/ C Uses ITIM, IDAT, ISTIM, IENTIM of /TIME/ C Calls SYOPEN, FLAGS, SYTIME, IFINIT, COPY25 C C===================================================================== C C THIS IS THE BEGINNING OF A QUANT RUN, SAY HELLO ! C WRITE(ITYP,104) 104 FORMAT(/,11X,'** DATA COLLECTION FOR', 1 ' QUANTITATIVE ANALYSIS **',/) C C===================================================================== C C OPEN THE RUN FILE AND READ THE FIRST RECORD C C Prompt for the name 1000 WRITE(ITYP,1004) 1004 FORMAT(' Please input the name of the run file', 1 ' you wish to use.',/,' Filename <.RUN> ? ',$) C C Read the name READ(IRD,1014,END=9020) NMRUN 1014 FORMAT(128A1) C C Open the file using .RUN as the default extension. CALL SYOPEN(IRUN,NMRUN,'.RUN',0) C C READ THE FIRST LINE IN THE RUN FILE C READ(IRUN,1024) TITLE,USER, IDAT,ITIM, & (IFLAG(I),I=1,4),NREP,NMOUNT 1024 FORMAT(20A4,5A4, 3I2,3I2, 10I1) C C This had better be a run file. IF(IFLAG(1).GE.3 .AND. IFLAG(1).LE.5) GOTO 1040 WRITE(ITYP,1034) 1034 FORMAT(' >> ERROR << THAT IS NOT A RUN FILE. IFLAG(1)=',I1) GOTO 9010 C This is an output data file for quantitative analysis C IFLAG(1) = 1 ! data from unknown (from program runfil) C IFLAG(1) = 2 ! data from calibration (from subroutine runfil) 1040 IFLAG(1) = 1 C C===================================================================== C C OPEN THE RAW DATA FILE C C Prompt for the name WRITE(ITYP,1104) 1104 FORMAT(' Please input the name of the output data file',/, 1 ' Filename <.RAW> ? ',$) C C Read the name READ(IRD,1014,END=9010) NMRAW C C Create the file using .RAW as the default extension. CALL SYOPEN(IRAW,NMRAW,'.RAW',1) C C===================================================================== C C GET THE CORRECT RUN TITLE AND USER NAME C The title and username are read into the CNT array so if he C just hits return we haven't written over the title or C username from the run file. C C Run title: WRITE(ITYP,2004) TITLE 2004 FORMAT(' Enter the run title of up to 80 characters',/, & ' or hit return to accept this:',/,X,20A4,/,' Title ? ',$) C READ(IRD,2014,END=9000) (CNT(I),I=1,20) IF(CNT(1).EQ.' ' .OR. CNT(1).EQ.'/ ') GOTO 2100 2014 FORMAT(20A4) C DO 2020,I=1,20 2020 TITLE(I) = CNT(I) C C User name: 2100 WRITE(ITYP,2104) USER 2104 FORMAT(' Enter your name ? ',$) C READ(IRD,2014,END=9000) (CNT(I),I=1,5) IF(CNT(1).EQ.' ' .OR. CNT(1).EQ.'/ ') GOTO 4000 C DO 2110,I=1,5 2110 USER(I) = CNT(I) C C===================================================================== C IFLAG(3) METHOD IFLAG 2 RUN TYPE CONC (was wtprct) SCONC (was constd) C 1 internal std 1 unknown int.std. N/A ? C 1 internal std 2 standards int.std. conc reference C 2 intens ratio 1 unknown u/p sample u/p reference (nochem) C 2 intens ratio 2 standards u/p sample C 3 spiking 1 always spiking phase N/A C 4 rel-I run. 3 always N/A N/A C 0 and 5 not implemented C---------------------------------------------------------------------- C C Important variables written to record 7: C CONC goes in colums 97-104 C SCONC goes in colums 121-128 C Some methods don't use both of these but let's not put junk in the file. 4000 CONC = 1.0 SCONC = 0.0 C C Method 0: pattern collection (not implemented). C IF(IFLAG(3).NE.0) GOTO 4100 WRITE(ITYP,4004) 4004 FORMAT(' >> You cannot do PATTERN COLLECTION', & ' with this version of the program.') GOTO 9000 C C Method 1: Internal standard. Need concentrations of phases. C 4100 IF(IFLAG(3).NE.1) GOTO 4200 IF(IFLAG(2).LT.1 .OR. IFLAG(2).GT.2) GOTO 4920 IF(IFLAG(2).EQ.1) WRITE(ITYP,4114) 4114 FORMAT(' INTERNAL STANDARD METHOD run to analyze an unknown.') IF(IFLAG(2).EQ.2) WRITE(ITYP,4124) 4124 FORMAT(' INTERNAL STANDARD METHOD run to measure a standard.', & /,' NOTE: the output from this run must be processed before', & /,' you can analyze an unknown.') IFLAG(1) = IFLAG(2) 4130 WRITE(ITYP,4134) 4134 FORMAT(' Enter the concentration of the INTERNAL STANDARD.') CALL RDCONC(CONC) C No default for CONC, and 0.0 is nonsense. IF(CONC.EQ.0.0) GOTO 4130 IF(CONC.LT.0.0) GOTO 9000 IF(IFLAG(2).EQ.1) GOTO 4800 C In a standard run, if the reference phase isn't pure we need to C know the concentration. WRITE(ITYP,4144) 4144 FORMAT(' Enter what the concentration of the phase you',/, & ' are interested in was in the sample before the internal',/, & ' standard was added. ') CALL RDCONC(SCONC) IF(SCONC.EQ.0.0) SCONC = 1.0 IF(SCONC.LT.0.0) GOTO 9000 GOTO 4800 C C Method 2: Intensity ratio. C C We don't store any concentrations here. The concentration is 1.0 for C the standard runs, and unknown for the unknown runs. C Store mu/rho of the standard for the standard runs; store mu/rho of the C unknown (whole sample) for the unknown runs. If IFLAG(4)=1, then chemistry C is stored instead of mu/rho. C 4200 IF(IFLAG(3).NE.2) GOTO 4300 IF(IFLAG(2).LT.1 .OR. IFLAG(2).GT.2) GOTO 4920 IFLAG(1) = IFLAG(2) IF(IFLAG(2).NE.1) GOTO 4250 WRITE(ITYP,4214) 4214 FORMAT(' INTENSITY RATIO METHOD run to analyze an unknown.') IF(IFLAG(4).EQ.1) GOTO 4800 WRITE(ITYP,4254) 4224 FORMAT(' Enter the mass absorption coeff. of this mixture.') READ(IRD,4234,END=9000) CONC 4234 FORMAT(F8.3) IF(CONC.EQ.0.0) IFLAG(4) = 1 C SCONC will be taken from each record in the run file. GOTO 4800 4250 WRITE(ITYP,4254) 4254 FORMAT(' INTENSITY RATIO METHOD run to measure a pure standard.', & /,' NOTE: the output from this run must be processed before', & /,' you can analyze an unknown.') IF(IFLAG(4).EQ.1) GOTO 4800 WRITE(ITYP,4264) 4264 FORMAT(' Enter the mass absorption coeff. of this standard.') READ(IRD,4234,END=9000) CONC C If mu/rho isn't given then chemistry must be. IF(SCONC.EQ.0.0) IFLAG(4) = 1 C Program Runfil will copy mu/rho sample into mu/rho standard in the C runfile to analyze an unknown. For now, leave it blank. SCONC = 1.0 GOTO 4800 C C Method 3: Spiking. We only need the concentration of the spiking phase. C 4300 IF(IFLAG(3).NE.3) GOTO 4400 WRITE(ITYP,4304) 4304 FORMAT(' SPIKING METHOD') IF(IFLAG(2).NE.1) GOTO 4920 IFLAG(1) = 1 WRITE(ITYP,4314) 4314 FORMAT(' Enter the concentration of the spiking phase.') CALL RDCONC(CONC) IF(CONC.LT.0.0) GOTO 9000 C SCONC is not used. GOTO 4800 C C Method 4: Relative intensity measurement; not for quant analysis. C 4400 IF(IFLAG(3).NE.4) GOTO 4500 WRITE(ITYP,4404) 4404 FORMAT(' RELATIVE INTENSITY MEASUREMENT') IF(IFLAG(2).NE.3) GOTO 4920 IFLAG(1) = 1 C CONC and SCONC are meaningless in this case. GOTO 4800 C C Method 5: Profile measurement (not implemented) C 4500 IF(IFLAG(3).NE.5) GOTO 4930 WRITE(ITYP,4504) 4504 FORMAT(' >> ENTER PROFILE MEASUREMENT',/, & ' with this version of the program.') C IFLAG(1) = 6 GOTO 5000 C C Enter chemistry for record 6 if necessary. (routine tests flags) C 4800 CALL CHEM IF(IFLAG(4).LT.0) GOTO 9000 C Chemistry or mu/ro is required for intensity ratio method. IF(IFLAG(3).EQ.2 .AND. IFLAG(4).EQ.0) GOTO 4200 GOTO 5000 C C Illegal run type for this method. C 4920 WRITE(ITYP,4924) IFLAG(2), (IFLAG(J),J=1,4) 4924 FORMAT(' >> ERROR << invalid run type flag for this method.',/, & ' > IFLAG(2) =',I2,' IFLAG(1 to 4) ='4I2) GOTO 9000 C C Illegal method flag. C 4930 WRITE(ITYP,4934) IFLAG(3), (IFLAG(J),J=1,4) 4934 FORMAT(' >> ERROR << unrecognized method code in run file.',/, & ' > IFLAG(3) =',I2,' IFLAG(1 to 4) =',4I2) GOTO 9000 C CC---------------------------------------------------------------------- CC---------------------------------------------------------------------- CC---------------------------------------------------------------------- CC REQUEST WT FRACTION OF REFERENCE OR SPIKING PHASE CC This dialog must be clarified!!! CC CC------------------------------ CONC ----------------------- C4000 CONC = 1.0 C IF ((IFLAG(3).NE.1) .AND. (IFLAG(3).NE.3)) GOTO 4150 CC v------^ v---------------^ CC INTERNAL STANDARD OR SPIKING METHOD - ENTER CONCENTRATION OF PHASE CC C4100 WRITE(ITYP,4110) C4110 FORMAT(/,' ENTER WT FRACTION OF REFERENCE OR SPIKING PHASE' C 1 '(F7.3)',/,' ? ',$) CC C READ(IRD,10020) CONC C10020 FORMAT(F7.3) C IF ((CONC.LT.0.0). OR. (CONC.GT.1.0)) GOTO 4100 CC CC -------------------------- SCONC ------------------------- CC Do this one first; Mu/ro should immediatly follow chem. CC If he/she/it hits return for Mu/ro branch back to 3010 CC IF THIS IS A STANDARD RUN GET THE CONCENTRATION OF THE STANDARD CC Is the default 0.0? C4150 IF (IFLAG(2).NE.2) GOTO 5000 ! run to measure standards C IF (IFLAG(3).EQ.2) GOTO 4170 ! Intens ratio method CC C WRITE(ITYP,4160) C4160 FORMAT(/,' ENTER THE CONCENTRATION OF THE STANDARD BEING RUN' C 1 ,/,' ? ',$) CC C READ(IRD,10020) SCONC C GOTO 5000 CC C4170 IF (IFLAG(4).EQ.1) GOTO 5000 ! Chem present on rec 6 C WRITE(ITYP,4180) C4180 FORMAT(/,' ENTER THE MASS ABSORPTION COEFF. OF THE STANDARD' C 1 ,/,' ? ',$) CC C READ(IRD,10020) SCONC C C====================================================================== C C WHICH LINES ON THE RUN FILE ARE TO BE DETERMINED ? C C All lines will be measured if rel. int. or calibration run) 5000 IF (IFLAG(3).GT.3.AND.IFLAG(3).LT.5) GOTO 5050 C WRITE(ITYP,5004) 5004 FORMAT(' Enter the number of each line to be measured',/, 1 ' (20I) ? ',$) C C Scratch array needed here. use IPKFND. READ(IRD,5024) (IPKFND(I),I=1,20) 5024 FORMAT(20I) C C If first line # was 0; she hit return: do all lines. C All you femminists take note that I used "she" this time. C Next time I'm saying "it" because "it" is neuter. IF( IPKFND(1).EQ.0) GOTO 5050 C C Set flags to skip all lines then change the ones we should measure. DO 5030, I=1,20 5030 LPEAK(I) = .FALSE. DO 5040, I=1,20 IPEAK = IPKFND(I) IF( IPEAK.GT.0 .AND. IPEAK.LE.20) LPEAK(IPEAK) = .TRUE. 5040 CONTINUE C Skip over where all lines are set. GOTO 5500 C C Do all lines if it hit return or if doing a rel. int. or calibration run. 5050 DO 5060, I=1,20 5060 LPEAK(I) = .TRUE. C C===================================================================== C C INPUT THE NUMBER OF REPETIONS AND MOUNTINGS FOR THIS SAMPLE C C Default is 1 & 1 unless these are given in the run file. 5500 IF(NREP.EQ.0) NREP = 1 IF(NMOUNT.EQ.0) NMOUNT = 1 C C Read number of repetitions. WRITE(ITYP,5514) NREP 5514 FORMAT(/,' ENTER NO. OF REPETIONS ? ',$) READ(IRD,5524) IANS 5524 FORMAT(I) IF(IANS.NE.0) NREP = IANS C C Read number of mountings. WRITE(ITYP,5534) NMOUNT 5534 FORMAT(' ENTER NO. OF MOUNTINGS ? ',$) READ(IRD,5524) IANS IF(IANS.NE.0) NMOUNT = IANS C C====================================================================== C C INITIALIZE THE INTERFACE AND WRITE THE FIRST 6 RECORDS OF THE RAW FILE C CALL IFINIT( IQUIT) IF( IQUIT.NE.0) GOTO 9000 C C WRITE THE FIRST 6 RECORDS OF THE FILE C C Rec 1 is run title, user name, flags, & runfile name. CALL SYTIME WRITE(IRAW,6104) TITLE,USER, IDAT,ITIM, (IFLAG(I),I=1,4), & NREP,NMOUNT,0,0,0,0,(NMRUN(I),I=1,6) 6104 FORMAT(20A4,5A4, 3I2,3I2, 10I1, 6A1) C C Records 2 through 5 are from the diffractometer configuration file. C CALL COPY25 C C Record 6 is the chemestry data or blank (depending on IFLAG(4)) IF(IFLAG(4).EQ.0) WRITE(IRAW,6604) 6604 FORMAT(128(' ')) IF(IFLAG(4).NE.0) & WRITE(IRAW,6614) (IPKFND(I),PKTIM(I),BKGTIM(I),I=1,NCHEM) C Make sure record length is 128. 6614 FORMAT(128(' '),T1,10(A2,2F5.2)) C NREC = 6 C C====================================================================== C C LAST THING BEFORE LEAVING: CLEAR ARRAYS EXCEPT FOR LPEAK C Everything gets set up to function properly elsewhere before it is C used. The only reason we do this is so that CALL STATUS won't print junk. C DO 7010, I=1,20 IPKFND(I) = 0 BKGTIM(I) = 0.0 PKTIM(I) = 0.0 PANG(I) = 0.0 CNT(I) = 0.0 CNT(I+20) = 0.0 7010 CONTINUE C DO 7020, I=1,6 C CNT(45 & 46) get cleared twice; that's cheap. CNT(40+I) = 0.0 CNT(44+I) = 0.0 IENTIM(I) = 0 ISTIM(I) = 0 7020 CONTINUE C GOTO 9999 C C===================================================================== C C RETURNS C C Return to main if user types ^Z or an error occurs. 9000 CLOSE(UNIT=IRAW, DISPOSE='DELETE') 9010 CLOSE(UNIT=IRUN) 9020 WRITE(ITYP,9024) 9024 FORMAT(' RUN CANCELED') IQUIT = 1 C THAT'S ALL SHE WROTE .... C 9999 RETURN END