-------
2200 CALL CLOSS(DSK,«>2«79>
C U3ffi4 TO* t& H/E
e
2203 MINS-INH
REAOC3. I«l,9>. IREF.RRT.
t AN. AH. mXT
C 6HSCK TOR 'MOT RJUMB'
lPi«W?08(LDCSO, 5, 1 TO?. 9. 1 )
IFUP1.GT. 0) GOTO 2230
IDATAdKS. 1>»1REF
XOATA( INC. 2)»1000*
69ATAC INO. t )"A8*D1
2230 IFdfO. LT. NfKO) GOTO 2210
C IF OTAWDARD THEN GET THE LIBRARY AMOUNTS
C
IF (I CODE. US. 7) GOTO 2300
2260 READ(ICH,e2iO.END«2479,EKR»2479> (ITXT09
2910 IF(KO. EO. 0> GOTO 1610
C CREATE REDUCED DATA FILE AND WRITE ROUNDED DATA
e
IFLDSC<10)»"RD"
IER-777K
CALL MAP8T( IEXTR. 1, 3. 2. IFLFN, 10. LNN, «2640)
CALL OP£NU( IFLFN, LCH, IER, 8S&40)
GOTO 2660
2640 KRITEmO, 8440)
GOTO 1610
2660 WRITE
F-FACTQR
DO 2730 I-l.NIND
CONC»80ATAC 1,2) «F+D4
• WRITE (LCH. 8340) I. CONC. SDATAd. 1), IDATACI. 1), IDATAd, 2)
2730 CONTINUE
CALL CLOSE ( LCH, «2740)
C«»t«B«tM4tt«IM«a»tt*ttB«»M«e»«N»tt»*»f»ttW*MttN»tt*tt«»»*»»«»«» -
q.i
-------
3740 IP"
COTO 2920
2000 lCaDF«"F<0>"
2830 IEB-T77W
CALL RCVBTdCRB?. IFLOSC.il. LGC,«290C>
CALL HQVgmCRDF, IFLFN, 10. LN. 62900)
IFUDSCUO-'ON"
IER-22S*
CALL FSLXUUFLBSC. *2890, »9000. !ER)
ec.ro 2870
2890 «aiTE
IER-777K
CALL HAPST(IEXTO, 1.3.2, IFLFN, 10. U&i. €2900)
CALL OPEKfldFLFN, ICH, IER. S290O>
IFdCODE. EQ. i) WSITEtTTO. 0170)
IftlCODE. E9. 2) HRITECTTO. 8174)
GOTO 2920
2900 UaiTE(TTO,8180> IEH
COTO 2890
2920 KO-1
VOL-0.
VEX-O.
VINJ«0.
VX-O.
IPR-CSt
CALL NULSKITXT, 1. 90)
C LOOK FOR ACQUIRE
C
2930 READ*ICH. 8210. END-2969. ERH-3969) (ITXT(I). I»1.4O>
IPlaMPOS(LOOKl,4. ITXT, 10. 1)
IFtlPl.LE. 0) COTO 2930
READ{ ICH, 8200, ENO-2969. ERR-29&9) (IACOT2(I), 1-1.4)
C LOCK FOR »*0
C
2940 BEAO( ICH. 0210. END-29&9. ERR-2969) (ITXT< I). 1-1.40)
IPR-NPOS{LOOK2. 2. ITXT. 10. 1)
IFUPR. LE. 0) COTO 2940
C READ LOO FILE PARAMETERS
C
CALL NW.ST(IEXOT2. 1,4)
CALL NULSTmUNITS. 1. 3)
CALL NULST(ITKP.1. 20)
REAO< ICH. 6290. ENO-2969. ERR-2969) I VS. VOL. VEX. IEXOT2, VINO
GOTO 2970
94
-------
1969 R0»0
2970 CAU. CLOSSUCH* 82980)
3980 IF -0.0
IDATAd, l)«0
lDATAU.2> JNO. < ITMP< I ), I-l. 9), IREF, RRT.
1 Afl.AM, UTXTd). 1-1,7)
IP1«NPOS(LOO»3. 3. ITMP. 9, 1)
IFUPl.OT. 0) COTO 3240
IDATAdKO. D-IREF
IDATA( 1KB, 2>«10OO*(RRT-»04>
SDATAC I NO, 1 )«A5?*D1
SOATA(IN0.2)-An
3240 IFdND. LT. NIND) GOTO 3220
COTO 3300
3279 KO-0
WHITEfTTO. 8400)
3300 CALL CLOSEUCH, 63310)
3310 1F(KO. EO. 0) COTO 28SO
C APP€NO RESULTS TO THE REDUCED DATA FILE
C
IFLD8C(10)°"RD"
IER-777K
CALL HAPSTdEXTR. 1, 3. 2. IFLFN, 10, LNN. «3489>
CALL MOVBTdCRU. IFLDSC, II. LOC.«3489)
CALL HOVBTf ICRU. IFLFN, 10. LN, 434B9)
CALL OPEN< IFLFN. LCH. 1ER. »3489)
IER-77K
READ (LCH. 8380.DTO-3489. ERR-3489) NPIND
IF(NPINO.KE. MIND) GOTO 3489
CALL POSITIOJKLCH. 1. -1. -1. IER, t334O>
C. WRITE SUB HEADER
C
3340 X1-VQL+D4
X2-VEX+D4
X3-VINJ--D4
X4-FACTOR*D4
WRITE (LCH. 8620) ICODE. IEXDT2, IACDT2, IPRDT, XI. X2. X3, X4
95
-------
c
e
€
C
3409
3490
35OO
3930
S600
C
C
C
4000
4040
5000
6000
warm RESULTS
F-FACTC8
B8 3480 t«»l,NIN3
CCKC«>SOATA< 1.
tS»TS 1FLOSC(U.
CALL PQSITIQNfLCM. t. -1. -1, JER. 33300)
CALL CLOSE
CALL FSUtUi IFLOSC. 66000. 96000. IER)
IFL88C(tO)»'RD°
CALL RAPSTf IEXTR. 1. 3. 2. IFLFN. 10. LNN. 99OOO)
CALL OPENC IFLFN. LCH. IER. 99OOO)
CALL P03ITION(LCH, l.-i.-l. IER. t4040)
COTO 5000
URITE(KCH.8680>
CALL R4PST< IEXTA. 1,3.3, IFLFN, 10. LNN, 050OO)
CALL D?ENB (IFLFN. I CM. TES, 03000)
CALL POSITIONC ICH. 0. 0. 112. IEH. *SOOO)
CALL FCOPV ( ICH, LCH. 93OOO, IE. IER)
CALL CLOSEdCH. IE)
CALL CLOSE (LCH. IE)
GOTO &OOO
CALL RESET
W8ITE(TTC. 3700) IER
IF«LST«0. Ed."L<0>") GOTO 1900
96
-------
7080 CAU, UMDITCBWQS'I
,016)
,016.
6000 FtBRftTC" !••/.• DATA REDUCTION KOBW.E (DRPSl)"./)
0010 RE?HAT<" efi/I^TKOO TEMPLATE IWSE E«.4A2. "3 > "»2J
(3030 POSRAT<« <7MC<57>WT ACCESS ERROR: ",OI6>
3060 R5tMAT(" MAMS LIST (L> OR HAKUAL WAHE ENTRY C°.A2. "3 > '.2>
00SO Ft^HATC" MAKE 07 U3T FILE f.SAa. "3 > ".2)
0100 FC3KATMi««LIST ACCESS ERROR: ",OI6>
8120 PtKHATC" 8*f^LE MAPS «e«.> C".8A2. "3 > ".2J
01 «O P-GSRAT4" <7>BU?L1C4>TC C5P SPIRE G&P&LS
I " S^KPLE WILL. CKLY BE PROCESSED IN
t • «ITH AM U>miSKiM SAWLE. ">
8150 n&X&IC KOU PROCESSING PR IRAS Y SAMPLE:
S16O FOaKATt" KO DATA FO3: °. A3. ": ". 6A3, -. ", A3. • ERROR:
B170 F03RftT(» KQU PKOCES3IKO DUPLICATE
8174
aiso
0300
3310
8320
8360
G2EO
8300
B32O
G330
834O
03 3O
8360
8370
83SO
83V)
8400
844O
8460
E4SO
0300
8320
G340
S5BO
8600
8620
8660
8680
8700
9000
9010
9O20
FCa«AT<» ERROR REA3IKO
FT»RAT<2A2. FIQ. 3, 68, P10. 3. 6X. -3A3. 68, F10. 3>
?Gim*T< 4X, 4A3. 6S. 3A3. 6X, SA2, 6X, 4A2)
FORMAT («!{,3aA3)
t&A5. SS)
OPEM ERSOH: »oi4>
FCH«AT(I3. 1H.35A3. 2X)
FORMAT U 3. 2X. 35A2J
FtE5HAT(- <7>MAKS COPARISO* PR08LEH WITH QCO7>«T FILE")
FCaKATCI3. IE. 9A2. 13, F7. 3. 6S.P13. O.F11. 3. IX. 7A2>
RHKATdS, 22. 17A3.F1O. S, 12A2>
FORMAT (• <7>EHROU READXKS ©J«KFILE!")
FCKRATi" <7>HD OPEN ERRCH : -. Z>
4*2. 4A2. 4A3, 4A2. 4A3. I«> .
, 3A3. 2A3. OF6. 3, 2A3. &A3)
. SA2. SA2. «A3, SX. "RESULTS FILENATE W/DD/VY")
FCSMATUX.32A2)
FCTHATdS. I4.F12. 3.F12. 0. 13. 16)
FORMAT (IX. 14)
FCmKAT( 1 X. 14, 4A3. 4A3, 4A3. '^B. 3)
FCRKATC" <7>CAN'T ^>PEND TO: ", A3. ": ",6A2, ". ". A3.
FOHHATi" 9 QUALITATIVE IDENTIFICATION SEGMENT" >
FORRATf <7X2UAL FILE ACCESS ERROR: -.016)
ERROR: ",OI6>
WRITEERROR FATAL:
CALL RESET
CALL LOADITCEXEC")
END
.014)
97
-------
C ORPG2. FR DATA MANAGEMENT REPORT CEN£RATO«
C D.RVAN 9/91 LAST REVISION: 09/23/82
PAUAS1STER TTO«tO.U>T-2.DSKol
PARAMETER HAXK»130, KAXSJ1-29
COWWJN /CJKX1/
1 IRPOT(4>,KVOL(2>, IHRNH<9>, IRRDT(4>,
1 IKSTO), IEHPL£<32>. I«MUST(4>. tCOND(32>. IACCNT<4>,
I ITKJM20). ITXT(SO), IACOT(4>. IACDT2U). KUNIT3O).
1 lRUNOO),NAKE<33>,K£TH. IF«THI4>, IPVTHU),
1 I£XDT<4>.IEXDTa<4>,ICKST<9),IRCBK,ICWfn32).
1 KCOMP<3>, ICO«P<&4), ICAS(6). IOATACHAXN. 3), SOATA(MAXN.2>. IVS(2).
I ICat), ICRQ3. ICREQ, NIKD, ISAM?, IYH, I HO. IOAY, IHR, InlN, IStC. IX. I0»1.
t 1C. !E£. tER. N8AMP. LTVP, LOC, I CODE. ICRDF, N?IND. ILEN. IANS. INN, UH,
I IP03. IPR. ILINE. IP1. IPS. IP3. LP.LP1.UTX. I. U. 13, 13. I NO. IREF.KO.KP1,
1 RRT. VOL. VEX. VINJ. VX. X. FACTOR. F. CONC. 01. 03, 03. 04. XI, X2, X3. X4,
i AS. AH. ICH. LCH. f(CH. IEOURCE
I K/NIT8(SO>,nATCH(6>.MCOO£(4),LQOKt(4).LaQK2(2>,LOOK3(3),LOaK4O).
1 LOO»3(4).LOOK6(4);LOOK/(4>, IEXTC(2>, IEXTN13). IEXTR(2), IEXT®(2).
t IEXTA(2>
CCKNON
1 leCDSCUl), IGCFN(IO). IFU3&C(U>. IR-NJKB), IFLFN(IO).
t !MJ>SCm>.INCNH. 18(11, HAXSM).LSTMO
/CJKX4/
t IOCNH(4>. IPRDT<4>
COMMON /CHAIN/
1 tPROC. IDF8W. IDFSU1. ITEHPdS).
1 IDFILE(12.A). ISFILEU1.4).
1 INSTO(3>. IREFTAflLEU!).
1 IA9D1.IAOD2. ISUB1. ISUB2. ISUB3. I5UB4,
t JAOD1. LIBRNAKE. LIBRKUMD. IBUF.
1 ISCN<43>. lACQ(JOO). I DAT < 43)
DATA RUNIT8/-UC", »L". " ". "OO". «<57>K". "CDB. "U«". "<57>K".
1 -CW. "W. -<37>C-. "M ".0.0. 0.0.0. C.0.0/
•HH", -C73>A"
DATA HCOD£/"UD"
DATA LCOX1/"AC"
DATA LCOA3/-6««<0>"/
"FX", "CK". "NS"/
•OU","IR","E<0>"
•T ", «FO", "UN". "
"OU", "NT"/
" "."NA-.'ME"/
•e
DATA LOOKS/"NO"
DATA LOOM/ "AM"
DATA LOOK3/"NO-
DATA LOOK6/"NO"
DATA LOOK7/"NO-
DATA IEXTC/-.G"
DATA IEXTN/". Q"
DATA IEXTO/". L"
DATA IEXTR/". fl"
Dl-0. 3
32-0. 03
D3-O. COS
D4-0. 0009
ICRU»"U<0>"
ICROS-"?<0>«
ICREO""-<0>"
ICRBF""N<0>"
KCHAN-1
NIND-O
KO-0
NSAMP-0
ICH-3
LCH-4
HCH-3
IFROM-1
CALL NULSTdTHP, 1,20) 98
CALL NULSTdTXT, 1.30)
-------
CALL cermivR, ira. IDAY. JHR. IMIN. ISEC.SSO, ix, ix, ix, ix, ix. ix>
IRPOT< 1 )=< l«0/10+48)«2S6+RCO< JHO. 10>+4B
IRPDT<2>"47»256+IDA,'/iC+48
IRPDT<3)" +48)0236+47
IHPDT<4)"<«OD«236*«OD(IYR. 10)*4B
GOTO 140
80 1RPDTU)-"R«"
XRPDTO)-«D<97>"
IRPDT<«)-"YY"
C SALUTATION
C
140 UftlTE(TTO.eOOO)
IF") GOTO 1260
IFlLBTMD.Ea. "H<0>«> GOTO 4300
IFROH»0
c err MODE: KANUAL OR NAHELIST
1190 WRlTEmO) " <7>"
IANS-"M<0>»
CALL INPTSCLSTHD. IANS. 1 . 08060. 07300 )
IF 1 1 ANS. NE. "L<0>". AND. I ANS. t&. "M<0>" ) COTO 1 1 30
IFCL6TMD. NE. "M<0>") COTO 1200
C CET NEXT MANUALLY ENTERED NAME
C
DO 1180 1-1.6
IFLNH( I >-ISFILEC 1+3. 1 >
1180 CONTINUE
CALL INPTSC ITXT. IFLNH. 8. 8B120. 67300)
COTO 1590
C CET NAHELIST AND READ
C
12GO CALL NULSTdNLNM. 1.8)
DO 1210 1-1.6
INLNM(I>-IDFILE"
INLDSC(2>-0
INLDSC(3)-1
INLDSC(10»«"NL"
INU)SC(11>-0
CALL FSLKUt INLDSC. 81240. 99000. IEE>
OOTO 1260
C NAMELI8T DOES NOT COMPUTE
1240 wRiTEcrro. atoo) IEE
OOTO 1200
1260 IC-0
CALL FHOPSCINLDSC.KCHAN. *1240. I€R>
CALL FMRDilS. KCHAN. 11»MAXSM. 91270, IEE)
1EE-0
1270 CALL FMCLS( KCHAN. 01 280)
12SO IFUEE. OT. 0> GOTO 1240
IC«<11«MAXSM+IEE)/11
NSAKP-IC
ISAKP-0
C GET NEXT NAME FROM LIST
C
1500 CALL NULSTf IFLNH, 1.8)
ISAKP-ISAMP+1
lf( I SAMP. OT. NSAMP) GOTO 7300
DO 1520 1-4.9
I1-I-3
IFLNMilU-ISd.tSAMP) QQ
1320 CONTINUE y9
-------
c
c
1990
1600
C
C
4800
C
C
4210
C
C
4220
C
C
4240
C
C
4260
PREPARE FILENAME FOR PROCESSIMO
CALL NULSTdFLFN. 1,10)
CO 1600 1-1.6
11-1*3
IFU>SCdl>»IFLKml>
lFLFNU)"IFLNmi»
CONTINUE
FIND KEY CHARACTER AND SET SAMPLE TYPE CODE
LN-L£N9dFLNM.a>
LNNHM+l
IFLOSCUO)-tlRD"
CALL MAP9T( IEXTR, 1,3. 2. IR-FN, 10. LNN. *4210>
CALL OPENR< IFLFN, XCH. IER. »4210)
GOTO 4220
HANDLE REDUCED DATA FILE I/O ERROR
CALL RESET
HRITE(TT0.8200) (IFLDSCC I). 1-4. 9)
OOTO 7200
READ HEADER PARAMETERS
READ( ICH. 8230. END-4210. ERR-4210) NINO. IACCNT. IPMTH. T.ANLST.
IEXDT. IACDT. IPRDT. ICQDE
READt ICH, 8240, END-4210, ERR«=4210) INST. KUNITS. VOL. VEX. VINJ, FACTOR.
NCOWP. dTKPd). 1-1,6)
READ( ICH, 8230. ENO-4210.ERR-4210) IRGBK. ICKBT. IPVTH. IRRNM, IRRDT
READdCH, 8260. END-4210.ERR-4210) ISMPLE
READ(ICH.S260. END«4210. £RR»4310> ICOND
READdCH. 8260. El^D-4210. ERR°4210) ICMNT
PREPARE HEADER VARIABLES AND GET QC/KT FILENAME
CALL eOBBL(ITMP.20.LTX>
DO 4240 1-1.6
IQCFN(I)-ITMP(I)
IQCDSC
IQCDSC(1)-"D<0>"
IQCDSC<2)«0
IQCDSCO)-!
IQCOSC(10)-"OC-
IGCDSCU1>-0
CALL FSLKU(1QCDSC.»4260.S9000.IER)
CALL MAPST( KUNITS. 4.6. 3. KVQL. 2. 1. 94260)
ICP-ICODE+l
ITYPEeNCHAR (MCODE. 4. ICP )
IFdCP. LE. 4) ICP«l
ICKX»0
X1-VOU+D4
X2-V£X*D4
X3-VINJfD4
X4-FACTOR+D4
CALL OPENR( IdCFN. LCH. IER. 44260)
READ(LCH, 8270. END-4260. ERR-4260) CTKP(I). 1-1.7). NM. NO. NN.
-------
4380 CALL DELETE("1:DMPRPTO.99-.IER.«4290)
4390 CALL OPENH( "1: DMPRPTC. 99". HCH, IER. 09000)
WRITE(KCH.B300) (JFLNH(I). 1-1, 6). IPRDT
HR1TE KUNITS, (IQCDSC. I"4. 7)
WRITECKCH.B330) Xl.KVOL, X4
WRITEIKCH.8340) JESDT. IACDT
WRITE(KCH.8330) X2. X3
WRITE(d€H,S360) IANLST. INST
URITECHCH. 8370) IROBK. ICKST
C UOFXCRNS
GOTO (4500,4500. 4500.4500, 4S10. 4520.4500. 4530) ZCP
SUB HEADER FOR U.O.F. X.N
WRITECMCH, 8510)
WRITE(HCH, 8520)
GOTO 4333
6UB HEADER FOR C
WRITE(MCH,8740)
WRITE* MCH. 8730)
GOTO 4535
SUB HEADER FOR R
WRITE (MCH. 8780)
WRITE(MCH. 8790)
eOTO 4535
BUB HEADER FOR 8
URITECKCH. 8820)
WRITE(MCH. 8830)
WRITE "
1F(X5. CT. B) LIMIT-"<76> "
XS-CQNC+D4
X6-AR+D1
C SKIP INTERNAL STANDARDS UNLESS SAMPLE IS A STANDARD
!F«IUSE. Efl. 3). AND. (ICODE. ME. 7)> COTO 4590
IFdNDa. NE. IPMCT) GOTO 7200
C UDFXCRNS
GOTO (4560,4910,4740.9000.5230.5530.4560.6030) ICP
C XCOOE- 0 1 2 3 4 5 67
C
C
4500
C
C
4510
C
C
4520
C
C
4530
4535
C
C
4340
C
C
4560
C
C
4580
4590
OUTPUT UNKNOWN AND NON-SFC SAMPLE INFO
IF (IUSE. EO. 2) GOTO 4600
6DATA-CONC
WRITE(KCH. 8580) INDQ. (NAME(I), 1-1. 12), XS. LIMIT. ICAS. X6
IF
-------
c
c
46OO
4690
C
C
4700
C
C
4740
C
C
4910
OUTPUT SURROGATE INFO FOR U OR N
IF(XLSA2. LE. 02) GOTO 4S90
CALL QCTST(CONC. SMEAN. BIGS. XLSA2. IQCMS, RECQV)
X7-XLSA2+D3
X8»R£COV+D2
UBlTEtHCH. 3610)
WRITE. 1-13. 24) . ICAS. X7, IGCRS, KEYS
IFtLTX. LE. 43) GOTO 4630
HRITE (NAKEU). 1-33. 35)
URITE) GOTO 6300
1FUCW. EQ. XCODE) GOTO 6500
CAU. PosmawLCH, o, o. o. IER. S9coo>
READUCH. 8640, END°4310, ERR*>4210) ICO. IEXDT2. IACDT2. IPRDT, VOL.
VEX. VINJ. FACTOR
l. 7) . NK, NO. NM,
ICP-ICD*!
X1-VOL*D4
X2-VEX+D4
X3-VINJ+D4
X4-FACTOH+D4
IF( ( ZCO. NE. 1 ) . AND. ( ICD. ME. 3 ) > GOTO 4260
READ(LCH. 8270. END-4260. ERR*426O> < ITMP < I > .
(ITXT(I).I-l, 16)
IF(ICO. EQ. 1) WRITECMCH. 8690) IFROT
IFtlCB. EO. 1> WRITECTTO. 8160)
IFdCD. EQ. 2) WRITE(PCH. 8650) IPRDT
IFCICD. EQ. 2) WRITECTra. 8180)
WHITEiMCH. 8330) Xl.KVOL. X4
WRIT£
GOTO 4S3S ' . '
OUTPUT SPIKE INFO
IFCIUSE. EO. 2) GOTO 460O
IFCXLSA2. LE. 02) GOTO 4390
X-CONC-SDATAC INDQ. 2)
CALL QCTSTCX. SMEAN. SIGS. XLSA2. IOCMS.RECOV)
X8"RECOV+D2
X7-SDATA ( I NDQ. 2 ) +D4
WRITE(MCH.8670) INDQ. (KAME(I). l"l, 12). X8. X7, IQCMS. KEYS
X7-XLSA2+D3
W»ITE(MCH. 8680) (NAttE(I). 1-13. 24), X7. X3
GOTO 4980
OUTPUT DUPLICATE INFO
IFUUSE. EQ. 2) GOTO 4600
IF
XBAR- < CONC +CQNCO ) /2
DIFF-CONC-CONCO
IF(DIFF. LT. 0. 0) DIFF=-OIFF
RC*°0+C»XBAR
IQCRS»»NO"
IF(DIFF. LE. RC) IGCMS-"OK"
X7-CONCO+D4
URITE
-------
C OUTPUT CONTROL STANDARD INFO
C
9230 IFOO.CT.LE. 03) OOTO 4590
CALL OCTSnCONC. CKEAN. SICC, XLCT, IGCM8. RECOV)
X7-SECGV+D2
WaiTE INDfl. (NAME(I), 1-1.12), X7, XS. IOCM8.KEYC
X7-XLCT+D3
HRITE (NAKE(I), 1-25. 35)
9260 IFdNDO. EO. NINO) COTO 7000
OOTO 4540
C OUTPUT REAGENT BLANK INFO
C
0530 IF(AR. LE. Dl > GOTO 4590 (NOT FOUND
CALL GCTSTCCONC. RMEAN. SICR. -1. 0. IOCMS, RECOV)
Jt7"RK£AN*3«SICR*D3
X8=RMEAN*2»SIGR+D3
WRITE(MCH. 8800) INDQ, (NAME(I). 1-1. 12), S5. X7. IOCK3. KEYR
WRITE INDQ, (NAKE(I), 1-1. 12). X5,LIMIT. ICAS. Xfc
IF(LTX. LE. 24) GOTO 524O
URITE(MCH.8583> (NAKE(I). 1-13. 24)
GOTO 5240
C MANAGE QUALITATIVE OUTPUT HERE
C
6500 READCICH. 3860. END-7000, ERR-7000) ICD, (ITXT(I), 1-1.32)
IFdCD.NE. 9) GOTO 7000
WRIT£(KCH.8S80) (IFLNM(I).1-1,6). IPRDT
6S4O READUCH.8900. END-7000. ERR-7000) (ITXT
CALL OPENR("1:DKPRPTC. 99-.DSK.7ER.*9000) •
CALL FCOPVtDSK. KCHAN, 47020. IE. IER)
7020 CALL CLOSE(DSK. IE)
CALL CLOSE(KCHAN.IE)
72OO IF(LSTMD. EQ. "L<0>") OOTO 1500
7300 CALL RESET
CALL LOADIT<"DMPC">
103
-------
eooo
6060
eoao
etoo
oiao
0140
8180
8200
8230
824O
6290
6260
3270
8280
83OO
8310
8330
6330
8340
8390
8360
8370
8510
6520
8330
8540
B390
6960
8970
8960
8SB9
B390
8610
8620
8630
8640
8690
8660
8670
8680
FORMAT<•
FORMAT<•
FQRMAT<» •,/." REPORT GENERATION MODULE NAME ENTRY C".A2. "3
FCHMAT<" NAME OF (.1ST FILE C*.8A2. "3 > *. Z)
FORMATC <7>NAM£LIST ACCESS ERROR: ".016)
FO3»«AT(" SAMPLE NARE <6&> C*.8A2, "3 > *.Z)
FORMAT(" NOU REPORTING ON PRIMARY SAMPLE: "<6A2>
NCM REPORTING ON DUPLICATE UNKNOWN*)
NSW REPORTING ON SPIKED UNKNOWN")
FORMAT(* <7>fiEDUCED DATA FILE ACCESS ERROR FOR ".6A2>
FORItAT(I4.6<4A2). 14)
FCmMAT(2(3A2>. 4FB. 3.2A2,6A2)
FORMAT( 9A2. 5A2, 4A2. 8X< 9A2. 4A2)
•FORMAT (32A2)
FCRMAT<7A2.3I4. 16A2. IX)
FORMAT(• <7>OC«7>RETHQD TEMPLATE FILE ACCE8SS ERROR")
FORHATC ". T20« "CS«7>MS COMBINED MEASUREMENT AND0/
T24"GUAL!TY CONTRCi. REPORT"/T22.6A2, T4C. 4A2/)
FORMATdX- ACCOUNT ID: "4A2, T38-SAMPLE TYPE: -A2)
FORMATdX" UNITS: °3A2.T38"QC<57>MT NAME: «4A2)
FORMATdX" SAMPLE VOLUME: *F8.3* ". 2A2. T38.
"F8. 3)
EXTRACTED: "4A2,T38"INJECTED: "4A2)
EXTRACTION VOLUME: "F8. 3" ML"T38
•INJECTION VOLUME: *FB. 3" UL*)
FOSMATdX" . ANALYST: "4A2. T38"INSTRUMENT: *3A2)
FORMATdX" REAGENT BLANK: "5A2. T38. "CONTROL STANDARD:
FORMAT(IX.T37"MEASUSED"TS3"CAS* >
FORMAT(2X"»40 COMPOUND NAME"T39*COKC*TS2DNUMBER"T67aAREA 2X)
FORMAT(6A2. IX. 13. IX. 2F7. 2. IX. 4F1O. 3. Al, IX)
FORMAT(2F7. 2. At. 2. 4F8. 3)
FORMAT(1H1./T24"SPIKED SAMPLE OC REPORT VI X.T31. 4A2/>
FORttATdX. /T32-X RECOVE«Y«7> MEASURED ORI6INAL QC"X
2X"NO COMPOUND NAKE*T32M AMOUNT ADDED AND ".
"SPIKED FINAL ASSESS*)
FORMAT { 14. 2X. 12A2. T32. "XREC»*. F7. 1, • X LSD**. F12. 3. T68. A2
FORMATdX. T7. 12A2. T32. "LSA-". F9. 2. " LSF--.F12. 3)
"-*. Al )
104
-------
8690
8700
0710
ffiC
B730
6740
8780
0760
B770
0780
B7W
eS©0
8310
6330
3960
G9OO
8920
B94O
9000
9010
9020
HAKS-TSa'COWCSNTRATiCfiSS BIFFEBSKCS- ASSESS")
FCSfWTW.aX. iSAa. T3S°U)l»"?ia. 3" X-'PtS. 3, 76@, A3. "-•. Al )
FCJlfiiVmS.TA, 11A3, T32"XHR— .Pil.a" »">
FOR«AT( J8, T34"RECOVERYO7>"TS
KCSmATUS-NO COWOUMB MAfe"T36«CA8 »"TS2
'EXPECTED ASSESS *>
FO*nAT< 14. 3X. S3A3. T32-%R£C-"F7. t" X LCH-T12. 3. T69. AS. •-'. Al >
FtJS«AT
FOamT(tX>T3S"K2ASy3gBO7>°T3a'CCWTnOl. AMD QC")
FORRATdS- KO COMPOUND WA?K"T36"CA8 fl"T3t
«UARNIf^» UHITS ASISSS*)
Ft3SRA?(I4. as. 12A2. T3a"l_RS--F12. 3" UCL»"F9. 3, T&S, A2. •-•. Al )
FO3IWUS.T7. 1262. T32-CAS -6A2" IAO.--F9. a>
FO^HATdX, TS^'KKOUM-TSa'CAS")
FOHKAT(1X"NO CCWCUND NAfEBT39"CONC"TS2"WI18ER'T67I'AREA">
FOaKAT(I3. JK. 32A2)
FC8FtAT< IH1, T26. "eC<37>MS QUW.ITATIVE AND"./.
T2&. "IDgNTIFXCATION REPORT', /.
T24. AA2i T42, 445. / )
RJRKATC •.37A2)
FORHATCi")
URJTEtTTO.9010) IER
FQaKAT<» <7>£RRaa FATAL: ",014)
CALL RESET
CALL LOAOITt-EXEC")
END
105
-------
C C«?Gl.Pa Ge/KETKOO TEKPLATE EDITOR - NSW TEMPLATE CREATOR
C D.fWa* 3/82 LAST REVISION: 3/23/33 FOR DEFAULT PARKETH FIX
PA8AKSTER TTO-10. LPT"3. ICK»3. LCH»4. «AXK»120
KAK2<36>. ICAS<&), ITKPC^O), ITXT<70>. I8NPNU1 ).KUNZT8O)i *
XCINTO). SCOT(4>. IUEMTC3). JU9T<«». lABRAYiHAXM).
IYR, IRQ. JDAY. IS. UEYD. r&S?T. K3ECS. IAWS, 61. 03. D3, 04. IUEN. I.'IEE.
ILOC. IP!. I>«3. NINO. It©. IREF. INM. ISEQ. RKOL. XPUX. A. 3. C. 0.
MCAN. GI03. XLS^. 8REAN. El OS, XLCT. CMEAN. 8ICC. STH?, IDEF.
IUSB XI. X2. X3. X4. 85. K6. 87. Xa. X9, X10, VI. Y2. Y3. Y4, N». NO. NR,
KO?. TCW*. IOPT. ISBFLB. IN3TR, INSTP. ISTRT. ISTOP.NflEC. IBIT.
KEYR. KEY3. KEYC. KCHAN. IE. II. 12
COMKQN
IEXTC«2>. IEXTN.
COWfflH /CJNK3/
ICCDSCttJ). IOCFN(S>. INITi3>. IH1, tm. 131
/CJMK4/
/CHAIN/ NPR09, IDF8M. IDFSH1. ITEWdS).
1 • IAOD1. IAOD2, ISUS1. IGUB2. I8UB3. ISUB4. JADD1.
1 IUBNAKS. ILIBNUMB. I8UF. I8CN<45>. IACQ<100>. IDAT(45)
DATA LOQKS/-NO
DATA LQCK6/UNO FK37>E "/
DATA LOOK7/-NOT FOUMD<0>"/
DATA ICAS/" OOOOOOO3XJOOSX)" /
DATA IEXTC/". ec<0>-/
DATA IEXTN/-.QMCO>"/
CALL errTKiYR. ino, IOAY, IHI. IMI. isi.oso. ix. ix, ix. ix. ix. ix>
IPRDT(l>-a47*2S6+IDAY/10*48
IPRDT(3)"(KOO+4&>*236*ttOD(IVR.
GOTO 100
90 URITE(TTO) " C7>PLEAS£ SET TIME AT MSDS"
GOTO 7200
100 REYD--D<0>0
IAMS-0
Dl-0. S
D2-0. 03
D3"0. 009
D4-O. 0009
URITEtTTO. BOOO)
CALL MULST( IOC.NM. 8. 4)
CALL NULSTCIQCL'SC. 1.111
CALL NULSTCITKP. 1.40)
CALL KULSTCITXT. 1.50)
CALL NULSTUQNFN. 1. 11)
CALL NULST< IQCFN. 1. 8)
CALL »4JLST
CALL MULSTt IARRAY. l.KAXM)
CALL tM-8T
-------
200 ITW»U)-"IN"
CALL IW>TS( INIT. ITMP. 3. S8020. 07200)
CALL PA08T(XNIT.3>
CALL INPT8( ITHP. IKNM, 4, 98040. C7200)
ILEN-LENO< IGCNM. 4)
IFULEN.NE. 7) COTO 440
DO 340 1-1.4
IQCFN-!QCNH(I)
240 CONTINUE
CAU. «APST( IEXTC. 1.3,3. IQCFN, 8. B. M40 >
IOCDSC(1)-"D<0>"
IOCDSC(3)-I
IOCDSC<10)-"aC"
DO 380 1*4. 7
IQCDSCt X >«IOCNM< 1-3)
28O CONTINUE
CALL P8LKU( IOCDSC, 0300, 550O. IEE)
GOTO 3900
C FILE NOT FOUND
C
300 DO 340 1-1.5
IQCFN(6-I*J >-IQCFN(6-I >
340 CONTINUE
I OCFN (!)-"!: "
C WRITE(TTO. 360) ( IOCFN< I ). 1-1, 8) , IEE
C360 FOSHAT<" OCFILE: -. 8A2. " ERROR: ".016)
GOTO 600
440 WSITE(TTO) • <7>ERROR ON OC<57>MT NAME. TRY AGAIN! "
COTO 300
900 U8ITE IEE
OOTO 300
600 CALL PADSTaQCN«.4)
630 tAITE(TT0.80BO>
DO 640 1-4.9
ITMP<:-3)-ISFIUE(I.l>
640 CONTINUE
CALL INPTS< IQMT*. ITMP, 11. «8iOO. »7200>
IEE-777K
CALL MAPSK1EXTN, 1,3, 2, IQNFN. 11. ILOC.«BOO)
C URITE(TTO, 660)
C660 FORMAT (" QUANFILE: ". 11A2)
OOTO 900
800 URITE IEE
OOTO 620
107
-------
90O CALL OPEKRJIONFN.LCH. IEE. «1000>
GOTO 1030
1000 CALL CLOSE(LCH. IE)
CffTO £00
C LOCK FOR "NO MAKE*
C
1020 READ IND. IND
INHS-INMS+I
C IFtNIND.NE. INKS) COTO 1000
GOTO 1060
C LOOK FOR "NO H/E*
C
1100 R£ADCLCH,B140.END=1000.ERRalOOO) UTXTd). 1-1. 4O)
ZP1-MPOS(LOOK6. 4. ITXT. 10. 1>
IF(IP1.U£.0> COTO 1100
C 1&XTE(TTO> " NAifES COUNTED. NOW READ INS REFERENCES. "
IREF-0
ISSQ-0
1200 REAO(LCH.8ieo,£ND>1000.ERR»1000) IND, . 1-1.25)
IKM-INH-fl
C LOOK FOR "NOT FOUND"
IPl««f»aS • <7>REFERENCE ERP.OR REPAIRED"
IF< INM. CT. i ) IARRAYC IWI>-IAR;»AY< IKH-I )
IF-1
eoro 1300
C SET INTERNAL STANDARD REFERENCE
C
1280 IARRAYCINM)»IREF
1300 IFtlNM. NE. IND) ISEG-1SSO+1
IFUNM. LT. INTIS) COTO 1200
CAUL POSITION(LCH. l.-l.-l. IEE. *1320)
1320 CALL Ci-OSECLCH, I£)
C ••••*••••«•»»*«-»•*••»»• «-«
108
-------
IFUSEQ.EQ.O) 60TO 1330
WRJTE • <7>S£QUEHCE HZ6MATCH ENCOUNTERED IN GUAM FILE.
GOTO 620
1330 WRITE* TTO. 8190) INKS
RWX-3. 0
XKOL-3. 0
A»9. 0
8*900.0
C«0. 1
D-9.0
RMEAN-0. 0
BICa-2. 0
XLSA2-20. 0
SrtEAN-73. 0
6I6S-13. 0
XLCT-20. 0
CF£AN*79. 0
6IfiC«19. 0
ITWO)«O
C DEFUS UNITS
c
1340 CALL INPT8CKUNITS. ITKP.3. «8330. «7200)
CALL PAD8T(KUNITSr3)
C DEFINE RMDL
C
KTKMJHDL
CALL INPTFCRMDL. XTMP. 68240. »7200)
C DEFINE XMOL
C
XTMP-XMDL
CALL INPTFJXMOL. XTMP. »8290. «7200)
C DEFINE DUPLICATE KINIRUM
C
XTW-A
CALL INPTF
C DEFINE DUPLICATE SLOPE
C
CALL INPTF(C. XTMP, $8280. »720C>
C DEFINE DUPLICATE INTERCEPT
C
109
-------
XT«P«D
CALX IWPTF
C DEFINE SPIKE K£AN RECOVERY AMOUNT
C
XTKP-EMEAN
CAU. INPTF(SMEAN. XTMP. ft8380.«7200)
C DEFINE SPIKE SIGMA RECOVERY
C
XTW»"8IGS
CAU. IKPTF(SIGS. XTMP, 9S400, »7200>
C DEFINE CONTROL STD AMOUNT
C
XTMP-XLCT
CALL IMPTF(XLCT. XTMP. 98420. *7SOO>
C DEFINE CONTROL STD MEAN RECOVERY
C
XTMP-CREAN
INPTFCCMEAN. XTKP. &6440. *7200>
C DEFINE CONTROL STD SIGMA RECOVERY
C
CALL IKIPTF(SIOC. XTnP.»e460.»7200>
GOTO 1700
164O WRITE(TTO) " <7>"
1700 IDEF-'NCO^
CALL INPTS( IANS. IDEF. 1, 6B480, »7200)
IFdANS. EQ. "Y<0>"> COTO 1340
IF (IANS. N£. "N<0>"» GOTO 1640
waiTEcrro.BSOO)
110
-------
C OPEN SC/MT FCHS FIRST TIRE
C
CALL MAPSTUEXTC. 1.3,2. ICCFN. 8.10. 044O)
CALL CPEWUiieCFN. ICH. ZEE. 97000)
URIT£< ICH. 8520) . (KUNlTSdl). 11-1.3). INMS.NHOFF.
1 MJECS. UPRDT(J), J-1.4), UNITtJl). Jl-1,3). (IPRDT(K).H»1. 4).
t
CALL aPEttiHIQKFN.LCH. IEE. 91600)
GOTO 30OO
1EOO CALL RESET
ufliTEcrro. aiso) IEE
GOTO 700O
C Fit® "HO HAKE-
C
200O REAO(LCH.8140.ENOalBOO.ERR*ieOO) tlTSTd). I»1.40>
IP1-NPOSCLODKS. 4, JTXT. 10. 1)
IF(I?1.LE.O> GOTO 2000
t
C READ NAME AND NUMBER
C
INfM)
3040 REA9. 1-1.35)
C WRITE NAME AND NUMBER
C
UflITE(KH.8S40> IND. D3
X3-XL8A21-D3
X4«9f£AN*D2
X5-SIGS+02
X6-XLCT*D3
• XB-SIOC+D2
C REAGENT • SPIKE * CQNTRL STD
WRITE (ICH. 8580) XI. X2.KEYD. X3. X4. XS. KEYD. X6. X7, X8. KEYD
IFtXNH. LT. INKS) 60TO 2040
CALL POSITIDN
-------
3900
7000
7200
8000
6020
8040
8060
8080
8100
8120
814O
8160
8180
8190
8230
8240
8290
8260
8270
easo
8290
8320
8340
8360
8380
8400
8420
8440
8460
8480
8300
8S20
8340
8360
8380
8600
CALL LQADIT<"DMPG2")
t$ITE(TT0.e600> IEE
K8ITE • <7>FATAL ERROR!"
CALL RESET
CALL LOAOIT<"£XEC">
FO»MAT("1". /, « QC<97>METHOD TEMPLATE EDITOR MODULE ",/>
FORMAT<" YOUR INITIALS: t". 3A2. "3 > ».Z>
FORMATi" GCC37>tt£TKOD TEMPLATE NAME C",4A2. "3 > «. Z)
FORMATi" <7>QC<37>MT ACCESS ERROR: ",OI6>
FORHATC/. " YOU ARE CREATING A NEW METHOD TEMPLATE. ", /,
" PLEASE IDENTIFY A RENAMED QUAN. 99 FILE REPRESENTING". /.
" A FIXED LIST OF STANDARDS. ALSO ACCEPT OR MODIFY"./.
• THE DEFAULT QC LIMITS FOR THE OC<57>MT. ", />
FORKAT(" CUAN REPORT OR SAMPLE NAKE C".11A2. "3 > ",Z>
FOHMAT(/.» <7>UNABLE TO PROCESS GUAN FILE. ERROR: ".016)
FORMAT<40A2)
FORMATCI3. 2X. 3SA2)
FORMATC13. 9A2. 14. 23A2)
FORMAT<" OUAN FILE HAS". 14. " ENTRIES. ")
UNITS OF MEASURE: t".3A2. "3 > ".Z>
REAGENT MDL: C".F7. 2. "3 > ".Z)
MATRIX MDL: C".F7. 2. "3 > ",Z>
FORMAT<"
FORMAT("
FORMAT("
FORMAT("
FORMAT<"
FORMAT<"
FORMAT<"
FORMAT("
FORMAT("
FORMAT{"
FORMAT<"
FORMAT<"
FOHMATC
FORMAT("
RANGE MINIMUM:
RANGE MAXIMUM:
DUPLICATE SLOPE:
DUPLICATE INTRCPT:
MEAN REAGENT BLNK:
REAGENT STD. DEV:
SPIKE CONC. ADDED:
MEAN SPIKE RECOV:
SPIKE STD. DEV:
• CONTROL STD. CONC:
MEAN CNT. STD RECOV:
CNT. BTD STD. DEV:
[
c
*
*
f
t
t
t
t
t
1
t
C"
C"
F1C
F1C
F1C
FtC
F7.
F7.
F8.
F6.
F6.
FQ.
.ft
.Ft
>.
}.
>.
1.
2
2
2
1
1
2
>.
i.
3
3
3
3
*
*
»
t
1
i
I
1
1
»
f
t
0
It
W
II
M
M
t
t
M
M
U
M
3
3
3
X
X
]
u
M
3
3
3
3
3
3
X
X
«
•
•
•
t
•
>
>
>
4
4
«
•
>
3
3
> U
> U
> °
^ **
° 1
M
».
. H
» u
",
>
>
.Z
i Z
t 2
. Z
Zt
Z)
Z)
,z
.Z
z>
H
*
",
>
)
)
>
).
>
Z)
z>
FOHMAT(
FORMATt" DID YOU MAKE A MISTAKE DEFINING DEFAULTS C".A2."3 y ".Z)
FORMAT<"1"." THE SKELETON GCCS7>MT: ".8A2. " WILL NOW BE CREATED.".
/." PLEASE USE EDIT OPTIONS TO COMPLETE THE DESCRIPTIONS. "./)
FORMAT(" ",4A2. 3A2. 314, 1X.4A2. 1X.3A2. 1X.4A2. 1X.3A2. "*">
FORMATi" ". 13. 1X.3SA2. "+">
FORMAT(" ".6A3, "»", 13. "!".2(F7. 2). "?",4(F10. 3). Al)
FORMAT (" ",2F7. 2. A1.2(F8. 2. 2F6. 1. Al))
FOJJMATC <7XiC<57>MT ERROR: -.016)
END
112
-------
C DMPOa. PR GC/MSTHOD TEMPLATE EDITOR - ROUTER AND REPORTER
C D.RYAN 3/82 LAST REVISION: 09/23/62
PARAMETER TTO-10. LPT«2. DSK-1. ICH-3, LCH*4, MAXM»120. MAXSM-23
COMMON /CJNK1/
1 NAKEO6), ICAS(6), ITMJM40). ITXT<70), IQKFNU1 >. KUNITSO). *
1 ICINT<3>, ICDT<4>. IUINTO). IUDT(4). lARRAY(MAXM),
1 IYR. IMO. IDAY. IX. KEYD. NHCFF, NRECS. IANS. 01. 02, 03. D4. ILEN. I; IEE.
1 ILOC. IP1. INMS. HIND. IND. IREF. INM, ISEO, RMDL. XMDL. A. B. C. 0.
1 RMEAN. SIOR. XLSA2. SHEAN. SIGS. XLCT, CMEAN. SICC. XTMP. IDEF.
t I USE. XI. X2. X3, X4. XS. X6. X7. X8. X9, X10. Yl. Y2. Y3. Y4. NM. NO. NR.
1 MOP. ICHN, IOPT, ISBFLD. INSTR. INSTP. ISTRT. ISTQP. NREC. IB IT.
1 KEYR. KEYS. KEYC. KCKAN. IE. U. 12
COMMON /CJNK2/
1 LOOK3(4>.LOOK6(4).LX}QK7(3),IEXTC(2).IEXTN(2), IUPT(32>.
1 IQST3(3>.NUttBS<5)
COMRON /CJNK3/
1 IQCDSC( 11 >. lOCFN(S). INITO). IH1, IH1. ISl
COMMON /CJNK4/
I iaCNM<4),IPRDT(4)
COMMON /CHAIN/ NPROO. IDFSH. IDFSW1. ITEMPdS).
1 IDFILE(12,6>, ISFILEdl.4). INSTDO). IREFTADLEi 11 >.
1 IADD1, IADD2, ISUB1. I SUBS. ISUB3, ISUB4. JAD01.
1 ILIBNAKE, ILIBNUMB. IBUF, ISCN<43>, IACQ( 100). IDAT(49)
DATA IUPT/"NOT SPECIFIED NORMAL SPIKE
1 "SURROGATE SPIKE INTERNAL STND. "/
DATA IQST3/-MRCSXHV
DATA K4UMBS/'01234567S<0>"/
MRITECTTO. 100) IOCDSCC1). (lOCDSC(I). 1-4.9). IQCDSC(IO)
100 FORMAT (" FILE: ". A2. ": ". 6A2. ". ". A2)
GOTO 700
300 CALL RESET
4OO WRITE(TTO. 8000) IEE
PAUSE ERROR EXIT! CR WHEN READY.
GOTO 1700
700 CONTINUE
WRITE+48
IPRDT(2)-47»256-fIDAY/lOf48
IPROT(3)-(MOO(IDAY. 10)+46)»256+47
IPRDT(4)-(MOO(IYR/10, 10>»48)«2S6-i-MOD(IYR. 10)+40
WRITE(TTO. 8010) IH2. IM2. IS2
GOTO 800
720 URITE " <7>PLEASE SET TIME AT MSDS"
CALL LOADITCEXEC")
BOO URITE(TTO. 8020)
CALL OPENRdOCFN. ICH. IEE. 9300)
CALL POSITION! ICH.O. 0,0. IEE. »300)
READ( ICH. 8040, END=>300. ERR-300) IQCNM, KUNITS. NM. NO, NR, ICDT. 1C INT,
1 IUDT. IUINT
CALL POSITIONCICH, l.-l.-l. IER, U820)
630 CALL CLOSE (ICH, IE)
ICHN-TTO
CALL GOSUB<»7000>
GOTO 980
113
-------
960 WRlTECrTO) " <7>"
WRITE(TTO,B060>
960 KOP-0
CALL IN?T8( ITXT, IANS. 1. »8030. 01900)
KOJ»«=NP08< IAN8. 1. IGST3. 3, 1 )
>. UE. 0. 08. HOP. ST. 5> GOTO 960
NKQFF-NQ
Dl-O. 3
08-0. 05
D3-O. 003
D4-0.0003
C K-WJOIFY TEMPLATE
C R»REPORT TEMPLATE CONTENTS
C 0=CET ANOTHER TEMPLATE NAME (FROM OMPQl)
C 8-ASSIHILATE SFC LIMITS
C X-EXIT TO DMPC
C M R 8 S X H
GOTO (2000. 4OOO. 1000. 1500. 1900. 960) MO?
OOTO 960
1000 CALL LOADIT("BMPQ1")
GOTO 1700
1500 CALL LOADITCDMPOS")
1700 IER-777
URITECTTO. 1800) I EH
1800 FORMAT(" <7>FATAL ERROR B.OI4)
1900 CALL RESET
CALL LQAOm-DttPCH)
STOP
C MODIFY CONTENTS OF OC METHOD TEMPLATE
C
2000 ICHN-TTO
. 8100
2040 IANS-"0<0>y
CALL INPTS( IX. IANS, 1. «8120. WOO)
IF < ( I ANS. AND. 377K ) . OT. 0 ) GOTO 2060
ISBFLD-NPOS( IANS. 1. NUMBS. S. 1 >-l
IFdSBFLD. EO. 0. AND. IOPT. GT. 0> GOTO 2200
IFUSBFLD. GE. 1. AND. ISSFLD. LE. 9) GOTO 2120
2060 URITE(TTO> " <7>"
GOTO 2040
2120 IOPT-(IOPT. OR. 2»«(ISBFLD-l»
GOTO 2040
2200 wair-'TTO- 8UO> NM
INSTP^NM
CALL INPTKISTRT, INSTR.eS 160. 0800)
CALL INPTKISTOP. INSTP. »8180. *800>
C X8THT-2
C I8TOP-3
IFdSTRT. CE. 1. AND. ISTOP. LE. NM. AND. ISTHT. LL. ISTOP) GOTO 2300
WRITE(TTO) - C7>"
OOTO 2200
2300 INM-ISTRT
2320 IFdNM.GT. ISTOP) OOTO 3660
VBITECTTO. 8020)
C NREOTRUE RECORD NUMBER MINUS 1
NREC-INM-1
C NRECS-SIZE OF THREE LINE RECORD (INCLUDING CR'S)
NRECS-NR
C NHOFF-THE HEADER OFFSET LENGTH
NKOFF-NO
114
-------
CALL OPENS ( IOC FN. ICH, IER. £3600)
CALL POSITION ( ICH. NSEC. NRECS, NHOFF, IER. 03600)
READUCH. 6200. END-3600. ERR-3600) IMD. . I-1.3S)
REAO( ICH. 8220. ENS<»3600. ERR "3600) ICAS. I USE. HMDL.
1 XMDL. A. B. C, 0. KEYD
READ< ICH. 3340. END-3600. ERR -3600) RHEAN. SICR. KEYR. XLSA2, SMSAN.
1 SI 03. KEYS. XLCT, CfiEAN. 5IGC, KEYC
CALL POSITIONUCH. l.-t.-l, IEE. S2360)
2360 CALL CLOSEdCH. IE)
3400 CALL OOSUB<»7400>
IH IT-IK
ISBFLD-1
2420 r.F((IDIT.ANO. IOf>T).E8. 0> GOTO 3300
C 12349678
GOTO (2500.2600.2700.2800.2900.3000.3100.3200) ISDFUD
C COMPOUND KANE MODIFICATION
C
2SOr> CALL INPTSdTXT. NAHE. 39. «8260. 93&40)
CALL PADSTthMME. 33)
GOTO 3300
C COMPOUND CAS » MODIFICATION
C
260O CALL INPT8UTXT. ICAS. 6. S82BO. »3640)
CALL NC AS (ICAS. 6. 02640)
CALL PADSTdCAS, 6)
GOTO 3300
2640 WRITE(TTO) " <7>"
GOTO 2600
C USE CODE MODIFICATION
C
2700 CALL INPTI ( IX. I USE. 68300. 93640)
IF( IUSE. 6E. 0. AND. I USE. LE. 3) GOTO 3300
WRITE-
IUSE-0
GOTO 2700
C HDL MODIFICATION
C
2800 CALL INPTFU.RMDL. *8320. »3640>
CALL INPTF(X. XMDL. »B340. 03640)
IF(RMDL. G£. 0. 0. AND. XMDL. GE. 0. 0) GOTO 3300
HRITECTTO) " <7>"
GOTO 2800
C DUPLICATE LIMIT MODIFICATION
C
2900 CALL INPTFU.A. »8360. 63640)
CALL INPTF(X. B. •8370.63640)
CALL IMPTF( X. C. «8390. »364O>
CALL INPTF(X. D. t»6390. «3640)
KEYD-"A<0>"
IF( (A. OT. 0. 0). AND. (B. QT. A) ) GOTO 3300
HRITE(TTO) " <7>"
GOTO 2900
C REAGENT BLANK LIMIT
C
3000 CALL INPTF (X.RMSAN, «8400, 83640)
CALL INPTF(X. 8IOR. 68430. «36«0*
KEYR»"A<0>"
IFCRKEAN. 6£. 0. 0. AND. BIOS. GE. 0. 0) GOTO 3300
WRITECTTO) " <7>"
GOTO 3000
115
-------
C 6PIKE 8AK»LE LIHIT8
C
3100 CALL IN?TF
CALL INPTFU. BIGS. 68480, »3640>
KEY6-BA<0>"
IP(XU£A2. OS. 0. 0. AND. 8MEAN. OE. 0. 0. AND. SICS. CE. 0. 0) GOTO 3300
3180 wairemo) • <7>-
OOTO 3100
C CONTROL STANDARD LIMITS
C
3200 CALL INPTFU. XLCT. «8300. *3640)
CALL INPTFiX.CMEAN. 8B460. 93640)
CALL INPTFt X, EIOC, 08480, »3640>
KEVC-"A<0>"
IF(XLCT. OE. O. 0. AND. CKEAN. CE. 0. 0. AND. SIOC. GE. 0. 0) GOTO 3300
WRITE(TTO) " <7>"
GOTO 32OO
C NEXT EU3FIELD
C
3300 ISDFLD-ISDFLD+1
IFdSBFLD. GT. 8) GOTO 3403
IBIT-I6HFTUBIT, 1)
GOTO 2420
34CO MR IYE ( TTO. 6020 )
CALL OOSUS( 07400)
3420 IANS-"W<0>"
CALL INPTSdX. IANS. 1, •8520.93640)
IFUANS. EQ. "N<0>") GOTO 3440
• IFdANS. »iE. "V<0>") GOTO 3430
WRITE (TTO. 8020)
COTO 2400
343O WRITE(TTO) " <7>"
GOTO 3420
3440 CALL OPEN< IQCFN. ICH, IER. 03600)
CALL P05ITION( ICH. KSEC, N3EC8, NHOFF. IER. 6360O)
Vl-A*D4
Y2»B*D4
V3-C+D4
Y4«D*D4
X4-SISR»D3
X3-XLSA2+D3
X7-SICS*D2
XB-XLCT*D3
X9-CREAN+D2
X10-SICOD2
WRITEt ICH. 8940) IND. (NAKE(I). 1-1.35)
URITEdCH. 0360) (ICAS(I). I»1.6). IUSE. Xt. »2, Yl. Y2. V3. V4. KEVD
URITECZCH, 8980) X3. X4. KEYR. XS. X6. X7. KEYS. X8. X9. X10. KEYC
CALL PCSITIONUCH. l.-l.-l. IER. »35OO)
390O CALL CLOSEdCH. IE)
INK-INH+l
GOTO 2320
C ERRCft PROCESSING
C
3600 CALL RESET
MITE (TTO, 6600) IER
OOTO 800
C ~D PROCESSING
C
3640 WRITE (TTO. 8620)
116
3660 IFdNM. LE. ISTRT) GOTO 800
-------
**«**•*«••••••»«••»« o«««-e<» •«»»«« «««»«o«VWW
C
C
3720
UPDATE HEADER IF SOMETHINO CHAN8ED
CALL OPENdOCFN, XCH. IER. 83600)
CALL POSITIONdCH. C, 0. 0. IKE, «400>
t«ITE< ICH, 0640) dftCNmn,I-l,4),,NH,NO,NR,
dCDTd),I«=l,4>. dCINTd),I»l,3>,dPRDTd), 1-1,4),
. I«1.3>
CALL POSITiDNi ICH, t. -1, -1. IEE. C3720)
CALL CLOSE (ICH. IE)
COTO 300
€••#««•*••»<»»**•••»»»»«»•»*•»»»»»***•»»»• »»»»»WWV
C
C
4000
C
C
4020
4040
4080
4100
4120
4160
4180
42OO
4400
C
C
C
C
7000
REPORT CONTENTS OF QC METHOD TEMPLATE
CALL OPENRdGCFN, ICH. IEE. »4200>
CALL POSITIONdCH. 0. 0. NHOFF, IEE. »4200)
READ t ICH, B040.END=4200.ERR»4200> IQCNM. KUNITS.NM.NO.NR, ICDT,
1 ICINT, IUDT, IUINT
CALL DELETE <"i:D«PRPTO. 99-, IEE, 94020)
CALL Of»EKW(»l:DMPRPTQ. 99-.LCH. IEE.«4400>
ICHN-LCH
CALL OOSUB(»7000)
IW1-0
WIITE(TTO) • OENERATINC REPORT"
INK'IN>H-1
IFdKfl. OT. NH) CQTO 4100
READdCH, B800. END-4200. ERR-4200) INQ. (NAME( I ).!•>}. 3S>
REAOdCH. 8220. END-4200. £RR=4200> (ICAS(I). 1-1.6). IUSE, RMDL, XMDL.
t A, 8, C. D. KEYD
READ( ICH. 8240. ENO»«200. ERR»4200> RtlEAN. SIGR, KEYR. XLSA2, SKEAN. SIOS.
I KEYS. XLCT. CMEAN. SICC. KEYC
IFCMODdNM. S>. fC. 0) COTO 4080
HRITECICHN, 8020)
CALL COSUB(»7400)
COTO 4040
WSITEdCHN, S020)
CALL CLOSE (LCH. IE)
CALL POSITXONtlCH. -l.-l.O. IEE. «4120>
CALL CLOSE(ICH-IE)
HRITE(TTO) " PRINTINO REPOflT"
KCHAN-LPT
CALL OPLPT
CALL FCOPY(DSK. KCHAN. S4I60. IE. IER)
CALL CLOSE (DSK. IE)
CALL CLOSEtKCHAN. IE)
COTO 800
WRITECrrO)
COTO 800
• <7>REPORT IN 1: DMPRPTQ. 99"
CALL CLOSEdCH. IE)
HRITEUNABLE TO GENERATE REPORT!"
CALL TIH2CSOOO)
PAUSE CR TO CONTINUE
COTO 800
REPORT HEADER WRITER
WRJTEaCHN, 8&SO) (IPRDT(I). 1-1,4)
HSITEdCHN. 8700) (IQCNH(I). I«i,4). (KUNITSd). 1-1.3)
WRITE (ICHN. 8720) (ICDTd). 1-1. 4). dUOTd >. 1-1. 4> .
URITEXICHN. 8740) (ICINT(I), 1-1.3), dUINT(I). 1-1.3)
WSITEdCHN. B7fcO) MM
CALL CORET
-------
7400
eooo
6010
0020
6060
8080
8100
8120
8140
SIM
B16O
8200
8220
6240
8260
6230
(2300
8320
8340
WRITE!ICHW.@7eO> INN
USJTEaCKN, 0300) (KARSd). !«•!, 33)
IX-IUSEoB+1
X1-SHDL*D3
X2-XKDL+D3
Y1-A*D4
Y2»8*C4
Y3-C*04
XS-XLSA2+D3
X6-SKEAN+D2
X7"SIC8*D2
X8-XLCT+D3
(ICASd).
KEYD
X1.Y1.V2
X2. Y3. Y4
IU3E. CIUPT(X), X-I1. 12)
X10-SICC+D2
USITEdCKN, E820)
HaiTEdCHN. 8B40)
WRITEdCKN, 68*0)
WRITEdCKN, 8380)
WRITEdCKN. 69OO)
WRITEdCKN, 8920) KEYR. X3. X4
WRITE! ICHN, 8940) KEYS, X3, X6, X7
WRITE!ICHN, 8960) KEYC. X8. X9. X10
CALL GORET
FORMAT!" <7>GCMT ACCESS ERROR: -.014." PUNT!">
FORMAT!" ". 12. ": «. 12, ". ", 12)
FORMATC"1">
FORMAT(4A2, 3A3. 314. IX. 4A2. IX. 3A2, IX. 4A2. 1X.3A2. 2X>
FCRKAT!//. " OCO7>MT EDIT OPTIONS:0./.
H -MODIFY CURRENT QC<37>MT FIELD3!8>"./,
R -REPORT CONTENTS OF QC<37>MT"./.
8 -UPDATE GCHT WITH SFC SUPPLIED LIMITS"./.
0 -«ET ANOTHER QC<57>MT TO PROCESS*. /.
X -EXIT TO DMP COMMAND LEVEL", /.
•»D -EXITS TO MSDS-.//)
FORMAT<" OPTION (MRSGXH) t",Aa,"3 > ".Z)
FOR«AT<"1".//." EDIT SUBFIELD INDEX:"./.
0 -DONE SELECTING 6UBFIELDS". /
1 -COMPOUND MAKE". /.
8 -CAS NUMBER*. /,
3 -USE CODE". /.
4 -MDL", /.
3 -DUPLICATE PARAMETERS"./,
& -REAGENT BLANK PARAMETERS". /.
7 -SPIKE PARAMETERS"./.
8 -CONTROL STANDARD PARAMETERS"./.
TO MODIFY THE PARAMETERS IN A GIVEN"./.
8UBFIELD. JUST ENTER THE SUBFIELD ". /,
NUMBER WHEN PROMPTED. MORE THAN ONE"./.
SUBFIELD MAY BE SELECTED. ". /,
*D RETURNS TO EDIT OPTIONS.",//>
FORMAT<" 8USFIELO • C",A2."3 > ",Z>
FORMAT!//." THERE ARE ", 14." COMPOUNDS IN THE OC<37>MT"./.
" PLEASE ENTER THE RANGE YOU WISH TO MODIFY:">
FORMAT!" STARTING COMPOUND C". 14. "3 > ". Z>
FORMAT!" STOPPING COMPOUND C". 14. "3 > ". Z>
FORMAT! 13. IX. 35A2. 2X)
FORMAT(AA2, IX, 13, 1X.2F7. 2, IX, 4F10. 3, Al, IX)
FORMAT(2F7. 2, A1.F8. 2.2F6. 1. Al. F8. 2.2F6. 1.A1. IX)
FORMAT!" COMPOUND NAME:",/," C". 35A2. "3",/, " >". Z)
FORMAT!- CAS *: C".6A2. "3 > ". Z)
FORMAT!" USE CODE:",/,
• 1 -SPIKE AMX37XW CONTROL",/,
" 2 -SURROGATE SPIKE ANDO7X3R CONTROL", /,
• 3 -INTERNAL STANDARD". /,
• USE CODE: C", 14, "1 > ",Z>
FORMAT!" METHOD DETECTION LIMITS:",/,
• REAGENT MDL C",F7. 2. "3 > "-Z>
FORMAT!" MATRIX MDL C".F7. 2. "3 > ". Z)
118
-------
8360
6370
B390
6400
I
6430
6440
I
8460
6480
6900
1
8920
6940
6360
8930
8400
6620
8640
CS660
6680
6700
6720
8740
6760
8780
8300
6820
6840
1
6860
1
8860
1
6900
6920
1
6940
1
6960
FORMATC
FORMATC"
FORMATC
a
FORMATC"
FORHATC DUPLICATE LIMITS:", X.
• RANGE MIN (A) C",FIO. 3. "3 > ". Z)
FC8KATC RANCE MAK CB> C".FIO.-3. "3 > ". Z)
FORMATC" SLOPE CO t".F10.3.°3 > «.Z)
FORMATC" INTERCEPT CD) t".F10. 3. "3 > ".Z)
FORMATC" REAGENT LIMITS: ".X,
» REAM CCH«C . F7. 2. "3 > ". Z)
FORMATC* STD. BSV. .F7.2. "3 > ". Z)
FOSHATC SPIKE PARAH3 .X.
* 6PIKE COMC ,F6. 2. "3 > ". Z)
M£AN XRECV ,F6. I, "» > ", Z>
STD. DEV S ,F6. 1, "X3 > ". Z>
CONTROL STAND. PARAHS: ". X,
STD. CONC C'.PB. 2, "3 > ",Z>
MISTAKES OJ* DISPLAYED PARAHS C",A2. "3 > ". Z)
FORMATC ° ". 13. IX. 33*2. "*" >
FORMATC" ".&A2. "8-. 13. "!'.aF7. 2. "7-.4F10. 3.A1)
FCRMATC" ».2F7. S.AH.F0. 2.2F6. 1. A1.F8. 2.2F6. l.Al)
FOa«ATC" <7>FJLE KS7>0 ERROR: ",OI6»
FCSMATC" <7>TASK TESHINATINS ABRUPTLY!")
FORMATC* •*. 4A2. 3A2. 3X4, IX. 4A2. IX. 3A2. 1X.4AS. IX. 3A2. °»°>
FORMATC4A2. 3A2. 314. IX. 4A2. IX. 3A2. IX. 4A2. IX. 3A2. 2X>
FOHMATCXX, T26. "OC<57>KaTHOD TEMPLATE". X.T31. 4A2. //>
FORMATC" ",T6."NA»E: ". 4A2. T42. "DEFAULT UNITS CU): ".3A2>
FCRMATC" -.T6. "DATE CREATED: ". 4A2. T42. "LAST UPDATE: ".4A3>
FORMATC" ",T6. "CREATED BY: ". 3A2. T42. "CHANCED SY: -.3A2)
FORMATC" ".T6. "NUC? COMPOUNDS: ". I4.T42. "EDIT SUBFIELDS: CN>B. XX)
FORMATC" COMPOUND NUMBER: ".14)
FORMATC" CD ". 35ft2)
FOSMATC" C2) CAS »: ".6A2.T34. « C3> USE CODE: ". 12. "-". BA2)
FORMATC" C4> METHOD DETECTION LIMITS: ". T34.
" C9) DUPLICATE LIMITS <97>".At."<57>:")
F03MATC REA6EMT MDL: ",F7. 2.T34. " HIN CA3: ",F10. 3.
" MAX CB3: ". F10. 3)
FORMATC" MATRIX MDL: -.F7.2.T34." SLP CC3: ".F1O.3.
" INT CD3: ".F10.3)
FORMATC" ". /. T32. "EXPECTED MEAN STD. DEV" J
FORMATC" C6> REASEMT BLANK LIMITS: <57>". Al. "<57>". T45. F7. 2.
"0 ",F7. 2. • U")
FORMATC" C7> SPIRED SAMPLE LIMITS: ". At. "<97>". T30. F8. 2.
" U ".F6.1. " X ".F6. 1." X")
FORMATC" C8> CNTRL STANDARD LIMITS: <97>«. Al. "<37>".T30.F8. 2.
•U ",F6.i," X ",F6. 1." X".X>
END
119
-------
C BHPRl.FR REPLICATE ANALYSIS KODULE - NAFELIST ENTRY/VARIF1CATIOM
C 0. RYAN 2/82 LAST REVISION: 09/23/82
PARAKSTER TTO,
1 JS?1?LE<2a>. IAKLST<4>. ICCM9<32), IACCNT<4>, ITM?(20). ZTXT(SO).
1 IACDTC4), IACDT2<4>.WAKE<39>. IPHTH(4),
1 IEXDT<4).IEXDT2<4).ICK8T<3).IRCBK. JCMNTC32). ICAS<6>. WCOJE><2>.
1 IAWSO). IVR, IDAV. IMO. IX.KODEP, LMD.LN.LKN,
t Ml. NO. f&i. 1C. I CHS. IPOS. ILEN. NINO. ICODE. X. ITP.
t LOOP. MI. IP. CN. AR. IDT. IRRT. F. ICO. Ml. H2. II. 12. INDQ. ICHAR.
1 INO. IU3E. RMOL. XMDL. A. B. C. 0. KEVD- RMEAN, SICft. KEYR. 2LSA2.
1 SKEAN. BIOS. KEYS. XLCT. CKEAN. SICC. KEYC. Al. A2. A3. XQC. SOC. YMDL
IEXTC(2).IEXTR<2).iasn(S).IQST2(3).
T(a4),ITYPS(32>.HHJ(36),KH206),KM2(36>.KHJA(n>.KH3A(H).
1 KH3C<3>. ITEK3C64)
CQKfSJN
1 IQCDSCdl), IQCFN(IO). IFLDSC(ll). IFLMn(8>. IFLFN(tO). INLDSC(ll).
t I!&I«*(@>.AMAT.KUNITS(3>. IS(ll.KAXSH), ITYP.MODE. H. NI, NO.
1 NS.KO. IH1.IM1.I81.N.FMDL
COMKON /CJNH4/
1 IQCI«<4). IPROT(4>
COMKOM /CHAIN/ NPROO. IDFSM. IDFSW1, ITERP(t5>.
1 IDFILEU2. 6>. ISFILEU1,4>, JNSTDt3>.IREFTA31_E(li>.
i IAOD1, IAOD2. ISU31. ISU32. IBUB3. ISUB4. JADD1.
1 LIBNAKE.LIBNUHB. 1BUF, ISCN(43>. lACQ(lOO). IDATC4S)
fe . •
DATA IEXTC/".QC<0>"/
DATA IEXTR/". RD<0>"/
DATA IQST1/"U.NCFMTRA<0>HV
DATA IOST2/UKLMHV
DATA T/63. 6S7. 9. 925. S. 841. 4. 604. 4. 032. 3. 707. 3. 499. 3. 353.
1 3. 250. 3. 169. 3. 106. 3. 005. 3. 012. 2. 977. 2. 947. 2. 921.
t 2.693.2. 678.2.861.2. 843.2. 831.2. 8:9.2. 607.2. 797/
DATA ITYPS/ "UNKNOWN DUPED UNSPIKED USPKDUP ".
1 "CNTRL STRGNT BLKNON-SFC CAL STND'V
DATA KH1/ 16*20040K. * CAS AVERAGE STANDARD X REL "/
DATA KHZ/ • NO. COMPOUND NAME". 7»20040X. "NUMBER VALUE ".
1 " DEVIATION STDEV "/
DATA KH3/ 36*36475K/
DATA KH1A/ " KNOWN MEAN LIMIT «/
DATA KH2A/ " VALUE %REC RANGE "/
DATA KH3A/ 11*36475K/
DATA KH1B1/ " REAGENT "/
DATA KH1B2/ " MATRIX "/
DATA KH2B/ " MDL "/
DATA KH3B/ 6»3647SK/
DATA KH1C/ "NO. OF "/
DATA KH2C/ -ITEMS "/
DATA KH3C/ "OM...»/
DATA FMUL/3. O/
«
DATA ITEMS/ "CONCENTRATION CONCENTRATION CONC.2REC.ti MDLR".
1 "REC. CONC. XREC KVTRIX MDL REL. RET. TIME
1 "RESPONSE FACTOR RESPONSE RATIO "/
CALL 6ETTKIYR. IMO. IDAY. IH1.IM1,:S1.«50. IX. IX. IX. IX. IX. IX)
IPRDT(l)«< IMO/1O+4S>«256+MOD< IMO.
IPRDT(2>-47«256+IDAY/10+4B
IPRDT(3)-(ROD< IDAY. 10)+4a>«236+47
IPRDT(4)«(MOD(IYR/10. 10>+48>*256+MOD(IYR.
GOTO 100
120
-------
80 WRITEPU-A£E BET TIKE AT MSDS"
OOTO 9300
tOO WUTECTTO.eOOO)
CALL NULST-"D<0>"
IQCDSC(2)-0
IQCDSCO)-!
iaCD3C<10J««"CC"
DO 4CO 1-1.4
l
C CALL MOV9T< ". <0>". IOCFN. 10, Q, eSOO)
C IQCFN(3>»"OC"
C WRITEtTTO,420) CCMT NOT ACCESSIBLE.
GOTO 2SO
6oo vmiTEtrro. so40>
620 tANB(l>-"H<0>"
CALL I WTS( ITXT, IANS, 3, »8080. 69300)
«ODE"NPOS( IANS. 9, IOST1. 5. 1 )
IF-'H<0>"
CALL INPTS( ITXT, IANS. S, 48140. »9500)
LMD«NPOSUANS, S, IOST2, 3. 1)
IF(U10. £0. 0. OR. U10. OT. 3) OOTO 800
C NAMELIST ACCESS
NX-0
NO-0
IC-O
N-0
00 940 Jal,MAXSM
00 930 X-l. 11
930 CONTINUE
94O CONTINUE
C K L U
COTO (1150,1000,990) LMD
C WILDCARD NAME LIST ENTRY WHERE USER ENTERS A NAME WITH
C A • 6ICN IN IT AND THE PROGRAM SUBSTITUTES DIGITS FOR
C THE * AND, BY SO DOING. GENERATES TEN FILE NAMES.
121
-------
930 ITMP<1)-"RO"
ITW»-"OT"
GOTO 970
960 URITE(TTO) " <7>ERRC8"
970 CALL IHPTSt ITXT. ITKP. 20. 48160. 09500)
C IANSU >-"t<0>" FOR SEARCH. THEN SET TO ASCII DIGITS
IANS(1)-21400K
If»OS«*f»OS< IAN3. 9, ITMP, 20. 1 )
IF< IPOS. LT. I. OR. IPOS. OT. 12) GOTO 960
ICHR-36400K
00 99O J=l. 10
ICHR-ICHR+400K I "0<0>" ...... «9<0>"
CALL KQVBTdCHR. ITHP.20. IPOS. $960)
00 988 1=4.9
928 I8-!NLNHU-3>
INLDSC<1)-"0<0>"
INLDSC(3)-1
INLDSC(10)««"NL"
CALL FSLKUdNLDSC. 01080. »1080. IER)
GOTO 1100
10BO WRITECTTO, 8200) !ER
GOTO 1040
1100 IC-0
IER~22K
CALL FKOPSdNLDSC. ICH. S10SO. IER)
CALL FHROdS. ICH. lleMAXSM, •1120. IEE)
IEE-0
1120 CALL FKCLSdCH.»l 140)
1140 IFdEE. ST. 0) GOTO 1C80
NX-WX-HC
C KEYBOARD ENTRY SEGMENT
1130 CALL NULSTCIFLNM. 1,8)
IF
GOTO 1130
122
-------
C NAMELIST VASIFICATION
C«
1200 UHITE(TTO) " REVIEW OF FILENAMES"
XTYP«O
00 1400 NI-NQ.NX
CALL NULSTdFLDSC. I. 11)
CALL NULSTdFLFN. 1. 10)
CO 1320 1-4,9
I1-1-3
IFLFNdl>-ISd.NI)
IFLDSCd >"ISd.NI)
1230 CONTINUE
IFLOSC<1)»"D<0>H
IFLDSC<2)-O
IFLBSC(3)»1
IFLDSC(10)«>"RD"
LN=LENG( IFLFN. 10)
LKN-LM+1
CALL MAPST( IEXTS. 1. 3. 2. IFLFN. 10. LNN. 81260)
CALL OPENRdFLFN. ICH, IER, $1260)
GOTO 1260
1260 CALL CLOSE(ICH.IE)
IE-1
GOTO 1360
1280 CALL NULSTdTMP, 1.20)
REA£( ICH. 8260. END-1260, ERR-1260) WIND, IACCNT, IPHTH. IANLST,
1 IEXDT. IACDT. IPRDT. ICODE
READ( ICH. 82805 END" 1260, ERR=1260) INST. RUN ITS, VOL. VEX. VINJ.
1 FACTOR. NCORP. (ITMP(I). 1-1. 6)
READdCH, 8300. END-1260.ERR-1260> IRGBK. ICKST, (ITXTd), 1-1. 21)
READdCH, 8320. END-1260, ERR°1260) ISMPLE
READdCH. 8320. END-1260. ERR-1260) ICOND
READdCH. 8320. END-1260. ERR°1260) ICMNT
CALL CLOSEdCH, IE)
IE-2
CALL NULSTdTMP. 8, 20)
DO 1300 1-4.9
IF(ITMP(I-3).NE. IQCDSCd)) GOTO 1360
1300 CONTINUE
IE-3
IF((ITYP. NE. 0). AND. (ITYP. NE. ICODD) GOTO 1360
IF (MODE. EQ. 0. AND. ICODE. OT. 3) GOTO 1360
IF (MODE. EQ. 1. AND. ICODE. NE. 6) GOTO 1360
IF (MODE. EQ. 2. AND. ICODE. NE. 4) GOTO 1360
IF (MODE. EQ. 3. AND. ICODE. NE. 2) GOTO 1360
IF (MODE. EQ. 4. AND. ICODE. NE. 6) GOTO 1360
IF (MODE. EQ. 9. AND. ICGDE. EQ. 5) GOTO 1360
IF (MODE. EQ. 6. AND. ICODE. NE. 7) GOTO 1360
IF (MODE. EQ. 7. AND. IOODE. NE. 7) GOTO 1360
IFdTYP. EO. 0) ITYP-ICODE
KRITE(TTO, 8400)
URITE(TT0.8420> (IFLDSCd). 1-1. It)
N-N+1
GOTO 1400
1360 HRITECTTO. 8440)
MRITECTTO. 8420) (IFLDSCd). 1-1. 11)
IFdE. EQ. 1) WRITE(TTO) " <7>DATA FILE ERROR"
IFdE. EQ. 2) WRITE(TTO) " <7>OC<57>MT ERROR"
IFdE. EQ. 3) WRITE(TTO) " <7>SAMPLE TYPE ERROR"
123
-------
1400 CONTINUE
C1480
C
C
C
C
C
C
C
C
C
C
C1300
IFKOT ENOUGH ACCEPTABLE NAMES"
GOTO 630
CAUL NULSTCINLKJ1. i.8)
CALL KULSTCINLDSC. 1,11)
INLDSC<1)-"D<0>"
INLDSC<3>-1
INLDSC<5)»MP<0>"
XNLDSC(10)-"NL"
CALL FHOPNdNLDSC, ICH. S9000, IEE>
CALL FMWRTdS, ICH. 11«NX, »1500, IEE)
CALL FMCLT< ICH. 99000)
1460 CALL LOAIMTC"DMPR2">
8000 FORMAT("1", //. • REPLICATE ANALYSIS MODULE (DMPR1)"./)
8020 FORMAT*" OCO7>KETHOD TEMPLATE NAME C",4A2. "3 > ". Z)
8040 FORMAT*" <7>", /.
" ANALYSIS OPTIONS: ", /,
" U -CONCENTRATION FOR UNKNOWNS'./.
" N -CONCENTRATION FOR NON-SFC SAMPLES", /.
• C -CONC. .^RECOVERY, 8c MDLR FOR CONTROL STANDARDS",/.
• F -RECOVERED CONC. & XRECOVERY FOR SPIKED SAMPLES". /.
" ft -CONC. 8. MDLX FOR MODIFIED MATRIX NON-SFC SAMPLES"./,
" T -REL. RET. TIME FOR ANY NOW-BLANK SAMPLE TYPE", /,
• R -RESPONSE FACTOR FOR CALIBRATION STANDARDS". /.
" A -RESPONSE RATIO FOR CAL. STANDARDS" )
6080 FORMAT(" OPTION (UNCFMTRAH) C", 3A2. "3 >"Z)
8100 FORMAT (" <7>"./.
1 " LIST DEFINITION MODES: ". /.
1 « K -KEYBOARD ENTRY OF EACH FILENAME"./.
1 " L -NAMELIST PLUS KEYBOARD ENTRIES"./.
1 • U -WILDCARD PLUS KEYBOARD ENTRIES")
8140 FORMAT (" OPTIONS (KLUH) C". 5A2. "3 > ",Z>
8160 FORMAT (" ROOT WORD AND IMBEDDED MILD CARD C-.20A2. "3 > ". Z)
8180 FORMATi" NAME OF LIST FILE C".BA2. "3 > U.Z>
8200 FORMAT C NAMELIST NOT ACCESSIBLE - ERROR ",OI4>
8220 FORMAT*" DATA FILE NAME CCR TO EXIT3 >
8240 FORMAT
B260 FORMAT(I4.6<4A2).I4)
82SO FORMAT(2(3A2).4F8. 3. 2A2, 6A2)
8300 FORMAT ( 5 A2. 3A2. 21A2)
8320 FORMAT (32A2)
8420 FORMATC FILE: ", A2, ": ",013, "
8400 FORMAT (« ACCEPTED ",Z).
8440 FORMAT (" <7>R EJECTED ". Z)
9000 WRITECTTO. 9020* IEE
902O FORMAT<" <7>FATAL ERROR ",OI4>
9300 CALL RESET
CALL LOADITCEXEC")
END
«.Z)
013, "-", 6A2.
, A2,
,A2)
124
-------
C OMPR3. FR REPLICATE ANALYSIS MODULE - STATISTICAL COMPUTATIONS
C O.RYAN 2/82
PARAMETER TTO-10. LPT-2, MAXN-120. MAXSM-25. DSK°1. ICH-l. LCH-4. MCH-3
COMMON /CJNH1/ INSTC3). RESPF(MAXN),
1 I6MPLEC32>,IANLST<4>,ICQND<32>.IACCNT{4>.1THP(20>. JTXT(SO),
1 IACDT<4).IACDT2C4),NAME<3S>.IPMTH<4>,
1 XEXDT(4>, JEXDT2<4>, ICKSTC3). IRGBM5). ICKNTC32). ICASC6). NCOttP<2>.
J IANS(5>. IYR, I DAY, !KO. IX. MODEP. LFID. LN. LKN.
I KH. NO. NN, 1C. ICHR, IPOS. ILEN. HIND. I CODE. X, ITP.
1 UJO?,MI,IP,CN.AR, XDT.IRRT.F. ICD. Ml. ftt, 11.12. INDQ. ICHAR.
1 IND. IU8E. RMDL. »MDL. A. B. C. D, KEYD. RMEAW. SICR. KEYR. XLSA2-
1 SMEAN. SIOS, KEYS. XLCT. CREAM. SXGC. KEVC. At. A2. A3. XQC. SOC. YMDL
COMMON /CJNK2/ IEXTCJ2). IEXTR(S). TQSTK3). IQST2<3>.
1 T(24>. ITYPS(32>.KHl(36>.KK2(36>.KH3(36).KHlA(ll>.KH2A(il),
1 KH3C(3>. ITEMSC64)
COMMON /CJNK3/
i rocDscat). iQCPwcto). IFLDSC(II). IFLKMO). IFLFN.
I INU«1(B>.AMAT.IS<11.MAXSM).ITYP.MC!>E.M.NI.NQ.
1 NX.NO, IH1. IMl.ISl.N.FMDL
COMMON /CJNK4/
1 IQCNM(4). IPRDT(4)
COMMON /CHAIN/ NPROO. IDFSW. IDFSH1. ITEMP(1S>,
1 IDFILE(£2.6). ISKILEdl. 4). INSTDO), IREFTABLEdl).
1 IADD1. IADD2. ISUB1. ISUB2. ISUB3. ISUB4. JADD1.
1 LI8NAME. LIBNUM8. IBUF. ISCN<4S>. IACQUOO). IDAT(4S>
DATA IEXTC/". QC<0>"/
DATA IEXTR/". RD<0>"/
DATA I6STX/»UNCFHTRA<0>H"/
DATA IflST2/"KLWH"/
DATA T/63. 657. 9. 925. 5. 841. 4. 604, 4. 032. 3. 707. 3. 499. 3. 335.
1 3. 290. 3. 169.3. 106. 3. 003.3. 012.2. 977, 2. 947.2. 921.
1 2. 898. S. 878. 2. 861. 2. 843. 2. 831. 2. 819. 2. 807. 2. 797 /
DATA ITYP8/ "UNKNOWN DUPED UNSPIKED USPK<53>DUP ",
1 "CNTRL STRQNT BLKNQN-SFC CAL STND"/
DATA KH1/ 16»20040K. " CAS AVERAGE STANDARD % REL "
DATA KH2/ * NO. COMPOUND NAME", 7«20040K. 'NUMBER VALUE ".
t • DEVIATION STDEV "/
DATA KH3/ 36»36475K/
DATA KH1A/ " KNOWN MEAN LIMIT "/
DATA KH2A/ " VALUE XREC RANGE •/
DATA KH3A/ 11*36475K/
DATA KH1B1/ • REACENT "/
DATA KH1B2/ " MATRIX "/
DATA HH2B/ " MDL "/
DATA KH3B/ 6*3&475K/
DATA KH1C/ "NO. OF "/
DATA KH2C/ "ITEMS "/
DATA KH3C/ "-«»«•«»/
125
-------
C
C
C
C
C
CU20
C1140
C
C
C«
C
C
C-
C
C1211
1200
C-
C
C«
1400
1420
1430
DATA ITEMS/ "CONCENTRATION CONCENTRATION
"REC.CQNC,XREC -MATRIX HDL
"RESPONSE FACTOR RESPONSE RATIO
WRITE(TTQ.3000)
IFCM.LE. 2) 60TO 9000
IC-0
CONC.XREr.8. MDLR",
REL. RET. TIRE
CALL FMOPSdNLDSC, ICH. 69000, IER)
CALL FHROCIS. ICH, 11«HAXSM, «1120, IEE)
IEE=O
CALL FWCLSdCH. 81140)
IF< IEE. OT. 0) GOTO 9000
IC-C11*MAXSM+IEE>/11
NX-IC
LOOP 1: MEAN VALUE SUMMATION
LOOP 2: STANDARD DEVIATION SUMMATION
URITEiTTO, 1211) M, MODE. NX
FORMATC CANDIDATES: ".14," MODE:
DO 1200 I-l.MAXN
AMATU, 1>»0.
AMAT(I,2)«0.
AMAT(I.3>-O.
RESPF(I)-O.
CONTINUE
MODEP-MODS-M
DO 2000 LOOP°1,2
FOR EACH ACCEPTABLE REPLICATE
00 16SO NI-l.NX
IFdSvll.ND.EQ. "NO") GOTO 1680
CALL NULSTdFLDSC, 1, 11)
CALL MULSTdFLFN. 1, 10)
DO 1400 I "4, 9
I 1-1-3
13, " NUMBER OF FILES: ",13)
IFLDSCd)"IS(I,NI)
CONTINUE
IFLDSC(1)-"D<0>"
IFLDSC(2)-0
IFLDSCO)-!
IFLDSC<10)-"RDa
LN«LENC(IFLFN, 10)
LNN-LN+1
CALL MAPSTdEXTR. 1,3,2. IFLFN, 10, LNN, *1420)
IF(LOOP. EQ. 1) URITECTTO, 8020) (IFLDSC(I), I"l. 11)
CALL OPENRdFLFN, ICH, IER.H420)
GOTO 1430
MIITE(TTO) " <7>REDUCED DATA FILE KS7>0 ERROR"
GOTO 1860
READ( ICH. 8040, f :D«14SO. ERR-1420) NINO. IACCNT. IPMTH, IANLST,
IEXDT, IACDT. IPRDT. ICODE
READ( ICH, 8060, END- 1420, ERR- 1420) IN5T, KUNITS. VOL, VEX, VINJ,
FACTOR. NCOMP. (ITMPd). 1-1,6)
READ d CM, B080. END-1420, ERR-1420) IRGBK, ICKST, (ITXT(I). I-i, 13)
READ (ICH. 8100. END-1420, ERR-1420) ISMPLE
READdCH, 8100. END-1420, ERR" 1420) ICONO
READ (ICH, 8100, END-1420. ERR-1420) ICMNT
M-NIND
126
-------
c«
c
c-
GET INTERNAL STANDARD CN/AR'S
1460
1900
C
1980
1600
1620
1630
1640
1660
1670
1680
1700
1720
1740
IF GOTO 1500
DO 1460 I-l.M
READ( ICH, 8120. END" 1420. ERR-1420) IP. CN. AR, IDT, IRRT
IFUP. NE. IDT) GOTO 1460
IF(AR. LT. 0. 5) GOTO 1460
RESPF(I)-CN/AR
CONTINUE
CALL POSITIQN( ICH, 0. 0, 371. IER, 41420)
FOR EACH ANALYTE IN FIXED LIST
DO 1740 MI«1,H
READ(ICH, 8120, END-1420, ERR-1420) IP, CN, AR, IDT, IRRT
X-0. 0
UNCFMTRA
GOTO (1600.1600.1600.1660.1600,1640.1630,1620) HODEP
X-CN
GOTO 1700
IF(CN.LT.0.0005) GOTO 1680
X-AR/CN
GOTO 1700
IF(CN. LT. 0.0005) GOTO 1680
X-(RESPi ,IDT)«AR)/CN
GOTO 1700
X-FLOAT(IRRT>/1000.
GOTO 1700
X—CN
IP (LOOP. EG. 1) GOTO 1670
RESPF+X
AMAT*1. 0
GOTO 1740
URITECTTO. 8160) MI
GOTO 1740
IF(LOOP. EQ. i) GOTO 1670
AMAT»AMATC!1I,2)+ GOTO 1860
127
-------
C FCfl SPIKED SAMPLES < REMAINDER OF . RD>
1730 READC ICH. 8140. END«>*1850.ERR-«1B50> ICD, IEXDT2,
1 IACDT2. IPRDT2. VOL. VEX. VINJ. FACTOR
IFUCO. Ett. 3) GOTO 1800
C BYPASS DUPLICATE INFO IF PRESENT
IFUCD. NE. 1) GOTO 1830
DO 1780 I-l.H
READ( ICH. 8120. END-* 1830. ERR»»1830> IP. CM. AH, IDT. IRRT
1780 CONTINUE
1750
1800 00 1840 HI-l.M
READ( ICH. 8150. END-»1B50. ERR»»1B50) IP, CN. AR. IDT. IRRT
IF«IP. EQ. IDT) GOTO 1840
IF-AMAT - <7>SPIKE PROCESSING ERROR"
I860 CALL RESET
1BBO CONTINUE
MEAN OH STANDARD DEVIATION COMPUTATION LOOP
DO 1900 MI»l.n
IF(AMAT(MI.3>.GT. 2. 0) GOTO 1940
MRITECTTQ. 81601 MI
AHAT(f1I. l)-O. 0
AHAT«0. 0
GOTO 1980
1940 IFtLOOP. EQ. 1) COTO 1960
AMAT(ni.2>-SQRT(AHAT(Ml.2)/(AMAT(HI.3)-l»
GOTO 1980
1960 AMAT(HI, l)-AnAT(HI, D/AftAT(Ml.3)
1980 CONTINUE
2000 CONTINUE
00 2100 I-i.M
WRITE
2100 CONTINUE
CALL RESET
CALL LOADIT(°DttPR3")
128
-------
BOOO FORHAT<"i".//.« STATISTICAL COMPUTATIONS (DMPR2)"./)
8020 FOSMATC" PROCESSING FILE: ". A2, ": ",013. " ". 013, "-",
t 6A2,". ".A2. " ",A2>
8040 FCR«AT,I4>
8060 FORHAT(2<3A2>,4F8.3.2A2.6A2)
8080 FORMATOA2,5A2.21A2)
BlOO FORMATO2A2)
8120 FORMAT(I4,F12. 3, F12. 0. IS, 16)
8140 FOR«AT.4FB. 3»
8160 FORMAT(" COMPUTATION ERROR ON COMPOUND ".13.*. WILL CONTINUE.")
9000 WRITEFATAL ERROR: ",OI4>
CAU. RESET
WRITE(TTO) " REPLICATE ROUTINE TERMINATING"
CALL LOADITC-EXEC")
END
129
-------
C DMPR3. FR REPLICATE ANALYSIS MODULE - STATISTICAL REPORT GENERATOR
C D. RVAN 3/82 LAST REVISION: 09/23/82
PARAMETER TTO-IO. LPT-2, MAXN-120. NAXSM-23, DSR-1, ICH»1. LCH-4, MCH-S
COmQN /CJNK1/ IMST(3),RESPF(HAXN).
1 ISS»LEt32>. IANLST<4>, ICONDC32). IACCNTI<$>,ITHP<20>,ITST(SO),
i IACDT<4>,IACOT2(4>.NAH£<39>,IPHTH<4>.
1 IEXCT<4). IEXOT2(4)i ICKST(S). IRGBKO), ICHNTC32), ICAS<6>,NCO«P(2>.
t IAN8O). IYR. IDAY. IHQ. IX.HODEP.LHD.LN. LNN,
t NH. WJ. NN. 1C. I CUR, IPOS. ILEN. NINO. ICCCE. X. ITP.
t LOOP. HI. IP. CN. AR. IDT. IRRT. F. ICO. Ml, «2. 11. 12. INDQ. ICHAR.
. 1 IND. IUSE. RMDL. XHDL.A.B.C. D. KEYD. RMEAN. SIGH. KEYR. XL8A2.
1 SHEAN, SISS. KEVS. XLCT. CKEAN. BICC. KEVC. Al. A2. A3. XOC. 6QC, YKDL
COWON /CJNK2/ IEXTC(2).IEXTR(2>.IGbTl(S).IQST2(3>.
1 T(24I. ITYPS(32).KHl(36).KH2(36>.KH3(36).KHlA(Il>.KH2A(lt>i
t KH3A(11).KH1B1<6).KH1B2(6>.KH2B(6>.HH3B(6>.KH1C(3>.HH2C(3).
1 KH3C(3>. ITEM3<64)
COKHM /CJNX3/
t laCDSCUJ). IQCFN(IO). IFUDSCdlJ. JFLNIK8), IFLFN(IO). INLDSC(U).
1 IhajSIO). A«AT<«AXN. 3J.KUNITSO). ISJ11. MAXSM), ITYP. JSOSE. M. NI. NO.
I NX. NO. IH1, I«J. IS1.N.FMOL
COhKON /CJNR4/
1 IQCMf(4>. IPROT(4>
COHKM /CHAIN/ NPROO.IDFSH.IDFSM1.ITERPCIS).
t IDFILEU2. 6), ISrILEdl.4). INSTO(3). IREFTASLECll >.
t IA001. IADD2. IEUB1. ISU8S, ISUB3. ISU84. JA001.
I LIBNAKE. LIBNUMO. IBUF. ISCNC43). IACQ°/
DATA IEXTR/". RD<0>-/
DATA IOST1/"UNCFMTHA<0>H"/
DATA IQST2/°IU.WH'*/
DATA T/43. 657. 9. 92S. 5. 841. 4. 6O4. 4. 032. 2. 707. 3. 499. 3. 333.
1 3. 250. 3. 169.3. 106. 3. 005.3. 012. 2. 977. 2. 947. 2. 921.
i 2. 898.2. 870.2. 841. 2. 843.2. 831. 2. 819. 2. 807,2. 797/
DATA ITYPS/"UN*NOUN DUPED UNSPIKED USPKDUP ".
t "CNTRL STRCNT BLKNON-SFC CAL STNDV
DATA KH1/ 16»20O40K," CAS AVERAGE STANDARD X REL "/
DATA KH2/ " NO. COMPOUND NAME". 7»20O40K. "NUMBER VALUE ".
t " DEVIATION STDEV "/
DATA KK3/ 36*36475K/
DATA KHIA/ " KNOWN MEAN LIMIT "/
DATA KH2A/ " VALUE XREC RANGE •>/
DATA KH3A/ 11«36475KX
DATA KH1B1/ " REAGENT "/
DATA KH1B2/ " MATRIX •/
DATA KH2B/ " MDL "/
DATA KH3B/ 6*36475K/
DATA KHJC/ "NO. OF "/
DATA KH2C/ "ITEMS "/
DATA KH3C/ »«—«-•/
DATA ITEMS/ 'CONCENTRATION CONCENTRATION CONC.XREC. 8, MOLR",
I "REC. CaNC. XREC MATRIX MDL REL. RET. TIKE ".
t "RESPONSE FACTOR RESPONSE RATIO "/
MODEP-MQDE+1
WRITE(TTO) * REPORT NOW BEINO GENERATED"
130
-------
C IC-0
C IER-22X
C CALL FKOPS< INU5SC. ICH. S9000. IER)
C CALL FKRDt IS. ICH. J 1*HAXSH, 9200, IEE)
C IEE-0
CaOO CALL RtCLStICH. »300)
C300 IF(IEE. GT. 0) 60TO 9000
C IC«U1«MAXSM+IEE>/11
C NX-IC
CALL FSLKUCIOC0SC. 69000)
CALL CPENRUOCFN.LCH. IER.«900>
GOTO 900
900 UKIT£1.7), NM. NO, NN.
1 (ITXT(I). 1-1.16)
CALL DELETE<-1:D«PRPTH. 99". IER. «1020>
1030 CALL C5»ENW<"1:DMPRPTR. 99". MCH. IER. 81970)
WRITE REPORT KEAOEfl
HflITE
URITE(HCH.SIOO) (ITEMS(I). I-M1. M2>.
1 IQCO&Cd). (IQCOSC(I). 1-4, 10)
M-ITYP»4+1
I2»*».!•!. 4)
C SHOW SAMPLE MAKES
^•••a •!•!•! ••••!••• • •••Mff«'M«amajrnii •••••!
UBITECh'.H, B160)
11-0
DO 1140 J-l.NX
IF
IF
-------
c«
e
c-
mmamo viamiatetmmtmKmafivma n &m mt
WRITE SUBHEADER - LINE 2
1360 WUTEOKH.8220) (KH3(I) 1=1.36)
C UNCFMTRA
OOTO (1380.1380. 14OO. 1400.1410, 1420,1380,1380) MODEP
1330 WRITE. 1-1, 11)
IF(KOOE. NE. 3> GOTO 1380
1410 HJ»ITE (KH2C
36)
UNCFHTRA
COTO (1460. 1460. 1480. 1480, 1500, 1920. 1460. 1460) MODEP
KRITECMCH,e200)
COTO 1580
WRITE(HCH, 6240) (KK3A(I ). 1-1. 11)
IF(WOD£. NE. 3) OOTO 146O
WRITE, 1-1. 6>
COTO 1460
WRITE. 1-1. 3)
NHITE MAIN BODY OF THE REPORT
BO 1960 MI-l.M
READ(LCH.8300.END-1870. ERR-1870) INDQ, (NAME(I), 1-1.33)
READ. 1-1.6). IUSE,
RKDL. XMDL, A, B. C. 0. KEVD
READ(LCH. 8340.END-1870.ERR-1870) RMEAN.SICR.KEYR.KLSA2.SKEAN.
6ICS. KEYS. XLCT. CKEAN. SIGC. KEYC
IRP»INT(AHAT(MI,3)*0. 5)
IFdRP. LE. 2) GOTO 1960
IFOUSE. NE. 3) GOTO 1660
IFCMODE. LT. 5) GOTO 1960
ICHAR-44400K i "I<0>"
CALL ROVBT"
CALL MOVBTCICHAR. ICAS.6, 1. *1680)
A3-0. 0
IF(HODE. NE. 2. AND. MODE. NE. 3) GOTO 1700
IF
-------
1720
e
1760
ieoo
1840
1870
1900
1910
A1-AMAT(HX. 1>+0. OOOS
A2=AHAT+0. OOOS
WflITE. I-1.6).
UNCFHTRA
GOTO (1900. 1900. 1600. 1600. 1940. 17&0, 1900.1900) HQOEP
UIITE(MCH.83SO) IRP
COTO 1900
XOC-AMATtMI, 1)»100. 0/A3+0. 03
SOC«A«AT(HI, S>«100. 0/A3*O. OS
A3-A3+0. 009
URITE(KCH. 84OO) A3. XQC.SOC
IF(KOD£. NE. 2) GOTO 1900
. 0005
IF<0>"
URITE.N£. - •> COTO 1930
CONTINUE
HRITE(MCH,8200)
GOTO 1960
1930 URITECMCH. 8460) (NAKEd). 1-13.35)
1960 CONTINUE
1970 WRITE(MCH.8470)
CALL RESET
KCHANoCPT
CALL OPLPT(KCHAN.»2020)
CALL OPcNR<"l:DNPRPTH. 99-.DSX.IEE.S9000)
CALL FCOJ»V(DSK. KCHAN. <2000. IE. IER)
2000 CALL CLOSE10SK. IE)
CALL CLOSE
-------
8040 FORMATC" <7XJCW ERROR: ".OI4>
8060 FORRATC7A2.3I4. t6A2,IX)
8030 FORMATC" ",/. T20. "CC<37>MS REPLICATE STATISTICS REPORT".//)
8100 FORWATC" ITEM OF INTEREST: ",8A2. T40,
1 «OC METHOD TEMPLATE: «. A2, ": ", 6A2, ". ". A2)
6120 FORMATC" SAMPLE TYPE: ", 4A2, T40,
1 "UNITS OF CONC: ",3A2>
8140 FORHATC" NUMBER OF REPLICATES: ",I4,T40.
1 "DATE COMPUTED: ",4A2>
8160 FQRKATC" «,//. T23. "SAMPLE IDENTIFIERS USED"./)
8160 FORMATC" ".&A2.T20.Z)
8200 FORMATC" ")
8220 FORMATC" ".36A2.Z)
8240 FCRKATC" «, 11A2. Z)
B260 FORMATC• ",6A2, Z>
8280 FORMATC* ",3A2>
8300 FORMATC13,IX. 35A2.2X)
8320 FORMATC&A2, XX. 13. IX. 2F7. 2. !X.4FtO. 3. At. tX)
834O FORRATC2F7. 2.A1.2CF8. 2, 2F6. 1.A1), IX)
8360 FORMATCI4, IX. 12A2. IX. 6A2.F12. 3, F10. 3, XX.F6. 1, IX. Z)
8380 FORMATC* «.14.Z)
8400 FORMATCF9. 2. 1X.2CF6. 1. IX), Z)
8420 FORMATCF12. 3. 2X. A3. Z)
8440 FOHMATC" <7>QC«T READ ERROR. TERMINATING")
8460 FORMATC" ",./. 6X, 23A2)
8470 FORMATC"I">
8480 FORMATC" <7>LINE PRINTER NOT AVAILABLE."./
1 "<7>PLEASE GENERATE DMPRPTR. 99 ASAP")
9000 URITECTTO,9020) IEE
9020 FORMATC" C7>FATAL ERROR: ", 014)
9900 CALL RESET
HRITECTTO) " REPLICATE ROUTINE TERrtl.tATING"
CAU. LQADITCEXEC")
END
134
-------
C
C
C
PWP'. "" r.VTA MANAGEMENT RUN RESULTS FILE PACKAGER
' -r-N .3. £2 LAST REVISION: 9/23/83 FOR LCM/LRB FIX
11/21/83 FOR TYPE 7 RECORD CHANGE
PARAMETER TTO-10, TTI=10, LPT=2. DSK=1
. ir-KPTr" MAXN«=120. MAXSM-23
•. r 'I:.-' J •'. :NK1/
i-'DT •*i.f>V.-L(2). IFORM(IO), ILDDT(4), INST(3),
< ::; > . :^NLST(4). ICONDO2). IACCNT(4), IPVTH<4>,
>. IACDT(4), IACDT2<4>, KUN1TS<3),NAME(33).
IEXDT(4>. IEXDT2C4), ICKST<3>,
:r, ;:>.i5l. iCWT(32).NCOMP(2). ICAS<6>. ICOUNT(75. 2), IQADT(4),
.-I«2. !H-V'!F. : «>, '.ilj, IDAY, IHR. IMIN. ISEC, IX, ICP, ITYPE. ICHK, ICD.
1C- TTt. :c.". >3 •'•"(P. ICOOE. NPIND, IANS, 1, Il,'i2, NM, NO. NN. INDQ. IUSE.
. ji.. VC'- •::•'.. rACTOR, CONC. 01. D2, D3, D4, XI, X2. X3. X4, X3, X7, IDT. IRRT,
BMOL. ••• c-_ •••. 3. c, OJ.KEVD. RMEAN. SIGR. KEYR. xusA2, SMEAN. SIGS, KEYS. AR,
«LCT. C:~:£«N, SIGC. KEYC. IPMCT, tCH. LCH, MCH. ISPEC. MW, ID. LN, LNN,
: TOTAL. I&CNT. I7CNT. I2CNT. ISCNT. ICCNT. IFCNT. IQBKS, ISMPLS
/C-JMK2/
). iEXTC(3). IEXTX(2). IEXTR(2). IQCC(12). INIT(2), IRRCH(7).
IP.CAS(S). IQCTK2). IQCT2(2). IQCT3(2), IQCT4(2), ISTRT(4), ISTOPI4)
rocrscc m- i JCFN< io.>. IFLDSCCII >. IFLNMIB). IFLFN( io>,
:-uL'?C(H ). INLNMOJ.LSTMD. IPRNM<91, IP«DT(4), 1QLNM, 1SU1. MAXSM).
:GCLS< io.50>
1 r'fRCS. ilirSW, IDKSW1. ITEMPdS),
'. IDFIL£U2, 6). ISFILEU1. 4).
1 IN3T3<3>, IREFTABLElll).
r^DDl- IACC'2. ISUB1. I3L-3I. t 3UB2. ISUB4.
jACDli LIDPNAME, LIBRNUM3. IBUF,
1 I5CN<43). IACQ( 100). IDATC45)
DATA IQCC/" LD1 LSD LDX LCM LRB "/
DATA IRRCH/"RE". "SU", "LT", "S ". "FI". "LE", "NA". "ME". "
C-ATA MCODE/"UD". "FX". "CR". "NS"/
SATA tEXTC/" Q". "C-.'OT-"/
SATA IEXTX/11. R". "R<0>"/
DATA lexTR/". R", "D<0>"/
UAFA I'iCT3/"LSl "/
D2=0. u5
02=0 005
'.•':'•!•-'
N . -C iu
T-cur--c
TODHS=O
'5AMF=0
LCH=4
-.a :o i»i. to
DO 10 J=l,20
IQCLSd. J)=0
135
-------
10 CONTINUE
DO 30 1-1.75 .
ICOUNTU. 1>"0
JCOUNT(I.a>«O
SO CONTINUE
CALL PWLSTUTW. 1,20)
CALL WULSTUTXT. 1,SO>
CALL KULSTCIRRNH. 1.9)
CALL CETTHIYH. I HO. I DAY, IHR. IMZN, ISEC.f.SO, IX. IX, IX, IX, IX. IX)
IRRDT< 1 )-< IMO/lO*48)«aS6+HODUMO, 10)+4B
IRRDT<2)-47o236+IDAY/10+48
IRRDT<3)-(MQD< I DAY, 10>+48>»256+47
IRRDT<4)»(HODUYR/10. 10)+48>«256+KOD(IYR. 10)+48
IRRNn(l)-(ttOD>(IKO/10+48>*236+HOD(IKO. IO+48
( IDAY/10+48>»3S6+HOD< IDAY. 10)-»-4B
(IHR/10-«-4S>»2364>100(IHR. 10>+48
IRR»«1<3)«< IMIMy 10*43 >»256*W3D( IMIN, 10)*48
COTO 140
so WRiTE(rro) « PLEASE SET TIME AT USDS. -
CALL LOAOITCEXEC")
C SALUTATION
c
140 WRITE COTO 4CO
WHITE(TTO) " <7>USE SEVEN CHARACTERS PLEASE"
OOTO 200
400 CALL PADSTUPMTH, 4>
CALL INPTSdNST. INSTD, 3. »8030, C9020)
CALL PADST(IMET.3>
C WRITE TYPE "1" RECORD
C
CALL MULSTOTXT. 1.32)
CALL PADSTdTXT. 32)
CALL «APST< INST. 1,6. 3. ITXT. 32. 2. 09000)
CALL HAPSTUPHTH. 1. 8. 4. ITXT. 32. 8. S90OO)
CALL HAPSTUNIT. 1.2.2. ITXT. 32. 16. *9000>
CALL OPENU( IRRNfl. MCH. IER. 99000)
URITE(MCH.B040) (IRRNM(I). 1-1. 3). . 1-1.3?)
ITOTAL-1
C GET MODE: MANUAL QR NAMELI8T
1190 URITETS(LSTKO. IANS, 1. 88060. 07200)
IFdANS. EO. •X<0>«) COTO 7100
IF (JAMS. ME. "L<0>«.ANO. IANS. HE. "M<0>") GOTO 1150
IF(LST«D. NE. «M<0>-) OOTO 1200
C GET NEXT MANUALLY ENTERED ^AKE
C
DO 1180 1-1.6
IFLNM(I)-ISF1LE(I*3. 1)
1180 CONTINUE
CALL INPTSUTXT. IFLNM. B. «8120. •1150)
OOTO 1590
-------
C CET NAMELX8T AND READ
e
1200 CALL WLST( INLNH, 1.6)
CO 1210 I«li 6
XNLWm I >-IDFILEd+3. 1 )
12SO CONTINUE
CALL INPTSUTKP, INLNM, 8. 08080. 61150)
00 1230 I "4.9
IMJ)SCd»«'INLNWI-3»
1230 CONTINUE
INLDSC(1)-"D<0>"
ZNLDSC<2>-0
INLOSC<3>»1
INLDSC<10)-«NL"
ZNLOSC(11>»0
CALL TSLKUdNLOSC. »1240. 41240. IEE)
GOTO 1260
C NAMELIST DOES NOT COMPUTE
124O URITECTTO. 8100) IEE
GOTO 1200
126O IC-0
CALL FHOPSdNLDSC.KCHAN. 61240. IER>
CALL FKROCS.KCHAN. ll«KAXSn. £1370. IEE)
1EE«0
1270 CALL FMCLS GOTO 1240
IC-U KMAXSM+IEE) / J 1
NSAMP-IC
C OET NEXT MAKE FROM LIST
C
1300 CALL*NULST( IFLfJM. 1. 8)
ISAMP-ISAKP+1
IFCSAMP. ST. NSAMP) GOTO 1190
00 1S20 1=4,9
IFLNM(I1) = IE(I. I SAMP)
1920 CONTINUE
C PREPARE FILENAME FOR PROCESSING
C
1990 CALL NULSTdFLFN. 1. 10)
00 1600 1-1.6
11-10
IFLOSC (1 1 )-IFLNMd )
IFLFNd)«IFLNMCI)
1600 CONTINUE
LN-L£NOdFLNM, B>
LNN-LN*!
IFLOSC <10)-11RD"
CALL MAPSTdEXTR. t.3. 2. IFLFN. 10, LNN. *4210)
CALL OPENRdFLFN. ICH, IER. S4210)
GOTO 4220
137
-------
c
c
4310
4215
4218
C
C
4220
C
C
C
C
C
C4230
C
C
4240
HANDLE REDUCED DATA FILE I/O ERROR
WRJTE IFLFN
CALL CLOSEdCH. IER,*4218>
CALL CLOSE (LCH. IER, S7090)
COTO 7090
READ HEADER PARAMETERS
CALL NULSTUTMP, 1,20)
READC ICH. 8230. END-4210. ERR=4210> NINO, IACCNT. IPMTH, IANLST.
1 XEXDT. IACDT. IPRDT. ICODE
READ( ICH. 8240. END-4210, ERR-4210) INST, KUNITS, VOL. VEX. VINJ, FACTOR.
t NCOMP. (ITMPO). I-l.6>
READ( ICH. 8230. END-4210. ERR-4210) IRGBK. ICKST. IPVTH.
1 (ITXT(I), I«l,13>
READ( ICH. 8260. END-4210. ERR-4210) ISMPLE
READC ICH. B260. END-4210. ERR-4210) ICOND
READt ICH. 8260, EKD=421O, ERR«4210> ICMNT
IFdCODE. CE- 6> OQTQ 4215
MIGHT BE USED TO CHECK HEADER TO SEE IF RD IS IN ANOTHER RR
00 4230 1-1.9
IF(ITXT(I).NE. IRRCH(I» COTO 4210
CONTINUE
It=ICODE«2+l
XQCTH1>-IGCC(I1>
IOCTK2>-IOCC(I2)
PREPARE HEADER VARIABLES AND GET QC/MT FILENAME
CALL G086L(ITMP.20.LTX>
DO 4240 1-1.8
IQCFN(I)>ITMP(I>
IQCDSC=0
CAL'. MAPSTC IEXTC, 1, 3. 2. IQCFN. 10. 6. S426O)
IQCDSC<1>--0<0>"
IQCDSC(2)=O
IOCDSC(3>«1
IQCDSC<10)»"OC«
IQCDSC(11)-0
CALL FSLKUIIQCDSC. *42AO. «42AO, IER)
CALL MAPSTCHUNITS. 4. 6. 3. KVOL. 2. 1. C4260)
ICP-ICODE*!
ITYPE-NCHAR
ICP FORCED TO 1 FOR PRIMARY UNKNOWN
IFCICP. LE. 4) ICP-1
ICHK-O
X1-VOL+D4
X2-VEX*D4
e
c
4260
X4-fACTOR+D4
CALL OPENR < I QCFN, LCH. I ER . 44260 >
READ (LCH, 8270. END-4260. ERR-4260) (ITMP, MM, NO, NN,
UTXTCI). 1=1.16)
IF
-------
C LOCK THROUGH LIST TO SEE IF TEMPLATE HAS BEEN USED
C
4380 00 4290 I»l, 10
ITXTeiaCFM(I)
4390 CONTINUE
IFUTYPE. EQ. "K<0>"> IT»T( SO>-"U<0>°
IF< IftLNH. Ed. 0) GOTO 4330
00 4320 1-1. Z6LNM
DO 4300 J-l, 10
IFUTXT
4340 CONTINUE
C WRITE TYPE "6" flECGSD FOR PRIMARY
C
4360 WHITE«ICAS(6)
ICHAR-NCHARI ICAS. 6. 10)
CALL HOVBTC ICHAR. IRCAS. 6. 9. »4260)
ICHAR-NCHAR( ICAS. 6. 9)
CALL MOVBTC ICHAR. IRCAS. 6. 8. »4260)
ICHAfl-NCHASdCAS, 6. 7)
CALL HavBT< ICHAR. IRCAS. 6. 7. *4S60)
IRCAS(3)-ICAS(3)
IRCAS(2)«ICAS(2)
IRCAS(l)-ICASd)
3EAD( ICH. 8370, END»4210. EflR"4210> IPMCT. CQNC. AR. IDT. XRRT
XS-CONC»D4
IF OR 2 .
c
C ITYPE-> U D F X C R
GOTO (4360.4910.4740.9000,3230,3330) ICP
e icaoe-. 012349
139
-------
c
c
4960
C
C
4990
C
C
4600
C
C
4610
C
C
4620
4630
4640
46SO
4660
4670
4710
C
C
4720
OUTPUT UNKNOWN SAMPLE INFO
IFdUSE. EQ. 3> GOTO 499O
IFdUSE. Efl. 2) GOTO 4600
WJITECMCH. B600) IACCNT, IOCT1. IRCAS, X3, KUNITS
I2CWT-X2CNT-H
UNKNOWN AND DUPLICATE LINE TERMINATOR
IFdNDQ. NE. NINO) GOTO 4S40
ICOUNT(I6CNT. 1)-I2CNT-2»ISCNT
URITE I6CNT. ICOUNTd6CNT. 1). ICOUNT( I6CNT, 2)
ITOTAL«ITOTAL+I2C1»T
OOTO 4610
OUTPUT SURROGATE INFO FOR U, D. F. OR X
ISCNT-ISCNT+1
X7»XLSA2*D3
HRITEmCH, 8600) IACCNT. IQCT3. IRCAS. X5. RUN ITS
HRITECMCH. 8600) IACCNT. IOCT4. IHCAS. X7. KUMTS
I2CNT-I2CNT+2
GOTO 4590
OUTPUT D OR F HEADER
IFdCODE. EQ. 0) GOTO 6000
IFCICHK. EQ. ICODE) GOTO 6000
CALL POSITIONCLCH. 0. 0. 0. IER,»4260>
READt ICH, 8640. END-4210. ERR-4210) ICO. IEXDT2. IACOT2. IPRDT. VOL.
VEX. V IN J. FACTOR
i ALL DONE WITH U. D. F. X
XCP-ICD+1
LOOK THROUGH LIST TO SEE IF TEMPLATE HA3 BEEN USES
DO 4620 1-1, 10
ITXT
CONTINUE
ITXT<10)-NCHAR(«CODE. 4. ICP)
IFdOLNH. EO. 0> GOTO 46SO
DO 4640 1-1. IQLNfl
DO 4630 J>1< 10
IFdTXT(J). NE. IOCLS(J. I» GOTO 4640
CONTINUE
GOTO 4670
CONTINUE
IFtlQLNM. EQ. 20> GOTO 4260
IOLNM-IQLNM+1
DO 4660 1-1, 10
IQCLSd. IQLNM)-ITXT-"LD0
IOCTl<2)-'2 "
IOCT2d)«" "
IOCT2<2)-" "
OOTO 4720
IFdCD. NE. 2) GOTO 4210
IQCTld)-"LS" •
iaCTl(2)-"F "
IQCT2(1>— LS"
IOCT2(2)-"A "
WRITE TYPE "6" FOR DUPE OR SPIKE
URITE(MCH. 6290) IACCNT. IPMTH, 1FLNM
IFdCD. EQ. l> WRITE(TTO) " NOW GENERATING RUN RESULTS FOR DUPLICATE"
IFdCD. EQ. 2) URITE(TTQ) * NOW GENERATING RUN RESULTS FOR SPIKE"
I TOTAL- I TOTAL* I
I6CNT-I6CNT+1
ICOUNT(I6CNT. 2)-ITOTAL
ISCNT-0
-------
c
c
4740
4760
C
C
C
4910
C
C
9330
9240
C
C
C
9330
9540
C
C
C
6000
READ dTKPd). I»l, 7>,NM,NO, NN,
,X-1, i6>
COTO 4940
OUTPUT SPIKE INFO
IFdUSE. EQ. 3) GOTO 4760
IFdUSE. EQ. 2) GOTO 4600
IF(XLSA2. LE. 02) COTO 4760
IFCNT-IFCNT*!
WRITECMCH. 8600) IACCNT. IQCTi, IRCAS, X3. KUNITS
X7-XLSA2*D3
WRITE-IFCNT
WRITE(TTO) I6CNT. ICOUNT(I6CNT, 1), ICOUNT(I6CNT, 2)
ITOTAL-ITOTAL*I2CNT
GOTO 4610
OUTPUT DUPLICATE INFO
IFdUSE. EQ. 3) COTO 4S90
IFdUSE. EQ. 2) GOTO 4600
WRITE(MCH, 8600) IACCNT. IQCTI. IRCAS. X3, KUNITS
I2CNT-I2CNT*!
CQTO 4390
OUTPUT CONTROL STANDARD INFO
IFdUSE. EQ. 3> COTO 3240
IF-"T "
URITE(MCH. 8600) IACCNT, IQCTI. IRCAS. X5. KUNITS
X7-XLCT+D3
URITECMCH, 8600) IACCNT. IQCT2. IRCAS. X7. KUNITS
I2CNT-12CNT+2
IFdNDQ. NE. NINO) COTO 4540
ICOUNT(I6CNT. 1J-ICCNT
WRITE(TTO) I6CNT.ICOUNT(I6CNT. 1), ICOUNT(I6CNT. 2)
ITOTAL-ITOTAL*I2CNT
GOTO 7000
OUTPUT REAGENT BLANK INFO
IFdUSE. EO. 3) COTO 5540
URITE(MCH. 8600) IACCNT. IQCTI. IRCAS. X5. KUNITS
I2CNT-I2CNT*!
IFdNDQ. NE. NIND) COTO 4540
ICOUNT
-------
6100 READdCH.8700. ENO-6800. ERR-6800) ISPEC. (NAHEd). I«l. 34)
REAO( XCH. 0710. END-6600. ERR-6BOO) CONC. ICA.S, IFCRM. KU, ID
irao. EG. -u •) GOTO 6ioo »SKJP UNKNOWN PEAKS
X3-CCNC*D4
XRCAS<3)-ICAS<6>
ICHAfi-NCHARdCAS.6. 10)
CALL KOVBTt ICHAR. IRCAS, 6, 9. «6800)
ICHAR-NCHAR ( ICA3. 6. 9)
CALL KOVBT( I CHAR, IRCAS. 6. S. »tBOO>
ICHAR-.NCHAR(ICAS.6.7)
CALL HOVBT< JCHAR, IRCAS. 6, 7, 96800)
IRCAS<3)-ICASO)
IRCAS(2>-ICAS<2)
IRCASU)-ICASU>
C WRITE "7" TYPE RECORD
I7CNT-I7CNT+1
URITEU4CK. 8720) IACCNT. I7CNT. IRCAS. IACCNT. IRCAS.KUNITS
GOTO 6300
6200 WRITE(MCH. B600) IACCNT. IQCT1. IfiCAS. X3. KUNITS
6300 I2CNT-I2CNT+1
GOTO 6100
6800 ICOUNT(I6CNT. D-I2CNT
C WRITE(TTO) I6CNT, ICOUNT
CALL POSITION* ICH. 0. 0. 149. IER. 09OOO)
00 7CZO 1-1.9
7020 ITXT-" •
DO 7060 1-10.13
7060 ITXT(I)oIRRDT(I-9>
WRITE (ICH. 8760) (ITXT. 1-1. 13)
CALL POSITION! ICH. 1. -1, -1, IER. 67080)
7080 CALL CLOSEUCH. IER. *9000>
7090 IF-> COTO 1500
GOTO 1150
C PUT NUMBERS IN PLACE OF «»»'S I "6" RECORDS
C
7100 CALL RESET
ISWH.S-I6CNT-IQBHS
C WRITEtTTO. 8300) ITOTAL. ISMPLS. IOBKS. IOLNM
IFdOLNM. LE. 0) GOTO 7190
CALL OP£N
URITEfnCH. 8840) ZNUM
7120 CONTINUE
CALL POSITIONCMCH,l.-l.-l, IER. «7SOO>
GOTO 9000
7190 WRITE(TTO) " NO DATA AVAILABLE"
TSttO CALL RESET
CALL DELETE( IRRNM. IER. «f9000)
WRITE(TTQ) " <7>RUN RESULTS FILE BEING PUSCUO.•
CALL LOAUITrDMPC")
GOTO 9020
142
-------
. C75-'0
C
C
C
8000
8010
8020
8030
8040
6050
aoto
eoeo
8100
ai20
cauo
1
C81SO
8200
6230
8240
6250
9260
8270
£280
8290
8300
6310
6320
6330
8340
8350
• 1
E360
8370
8340
8550
8560
8570
8fcOO
9640
Si30
8700
8710
8720
8740
3760
caaoo
C
C
C
C8320
8840
9000
9010
9020
CALL NULST< ITMP. 20)
ITMP< I > = "N<0:>"
CALL INPTSUANS. ITMP, I. S3820, »"020)
IF( t^Na. EQ. "V") GOTO 9020
CALL *E£ET
CALL LOADIT("DMPP2")
FCRMATC1 ". /. " RUN RESULTS FILE GENERATION MODULE (DMPP1)",/.
" PUN RESULTS FILE NAME IS: ",9A2>
FORMATf" ENTER YCUP INITIALS C",2A2. "3 > '.Z>
FORMATC1 ENTER CENcPIC PARMETH CODE C".4A2. "3 > ",Z>
FORMAT*" ENTER INSTRUMENT IDENTIFIER C".3A2, "3 > ",Z)
FORMATC' 1", 5l IX, A2) . 32A2)
FoRMATC1! PROCESS MODES:"./,
L - NAMELIST SAMPLE NAME ENTRY",/.
" H - MANUAL SAMPLE NAME ENTRY", /,
X - EXIT TO SEND MODULE"./,
" 'D - EXIT WITHOUT ACTION")
FORMAT!" L, M, OR X C". A2. "3 > ",Z)
FORMATC1 NAME OF LIST FILE C",BA2. "3 > ". Z)
FORMATC1 <7:>NAMELIST ACCESS ERROR: ".016)
FORMAT!" SAMPLE NAME <*> C",8A2, "3 > ".Z>
FORMATC1 NOW REPORTING ON PRIMARY SAMPLE: ",6A2>
FORMATC' NOW REPORTING ON DUPLICATE UNKNOWN")
FORMATC' NOW REPORTING ON SPIKED UNKNOWN")
FORMATC1 <7>ONABLE TO PROCESS REDUCED DATA FILE ". 10A2)
FORMAT (1 4. 6<4A2>, 14 1
FORMAT<2i3A2>. 4F3 3. 2A2. 6A2)
FORMAT; 5A2, 5A2, 4A2. 13A2)
FCRMATO2A2)
FQRMATC7A2. 314. 16A2. IX)
FCRMATC' <7>UNABLE TO PROCESS QC<57>METHOD TEMPLATE FILE ", 10A2)
FORMATC1 6 ".4A2. " »*# P ". 4A2. 37X. 8A2)
FORMATC 1H1, " RUN RESULTS NOW BEING GENERATED FOR SAMPLE: ",6A2>
FORMAT." £FC SAMPLE ID: "4A2. T38"SAMPLE TYPE: "A2>
FQRMATC' UNITS. "3A2, T38"OC<57>MT NAME: "4A2>
FORMAT) " SAMPLE VOLUME: "FB. 3" ",2A2, T38.
"FACTOR: "F8. 3)
FGRMATC1 EXTRACTED: "4A2. T38" INJECTED: "4A2>
FORMAT<" EXTRACTION VOLUME: "F8. 3" ML"T38
"INJECTION VOLUME: "F3 3" 'JL'1 )
FORMAT!" ANALYST: "4A2, T25" INSTRUMENT: "3A2)
FORMATC1 REAJENT BLANK: ", 5A2, T38. "CONTROL STANDARD: "3A2/>
FORMAT (I 3, IX. 35A2, 2X>
-CRMAT(tA2. '.•/. 13, 1X-2F7. 2. 1X.4FIO. 3. Al. IX)
FORMAT (2F7. 2. Al, 2(F8. 2. 2F6. 1, Al). IX)
FORMAT! 14. F12. '.>. Fi2. 0. 15. 16)
FORMATC1 2 ". 4A2, .X. 2A2. "C". 5A2. 1X.E10. 3. 1X.3A2, 36X)
FORMAT! 14. 3C4A2). 4FB. 3)
FORMAT (13. IX, 32A2 )
FORMAT' IS. IX. 34A2)
FORMAT' 18X, F12. 3. IX. 6A2. 2X. 10A2. 15, IX, A2)
FOSMATC1 7 002 ".4A2.I4," C", 3A2. IX. 24A2. 1 X )
FORMATC1 2 -.4A2. " C1 . 5A2. 12X. 3A2. '
FORMAT(IX, 13A2. Z)
FQRHATC1 ", /" RUN RESULTS FILE HAS". 16,
1 " WITH DATA FOR". 14, " SAMPLES."./,
1 " THERE ARE". 14. " QUAL BLOCKS",/.
1 " AND". 14, " DISTINCT PARTYPE3 USED.
FGRMATC' ",/, " EXIT TO MSDS C".A2. "3 >
FOPI-IATESROR FATAL:
CALL RESET
CALL LOADITC'EXEC")
END
PNQ",30X)
RECORDS", /.
11)
". Z)
143
-------
C DHPP2. FR DATA MANAGEMENT RUN RESULTS FILE WRAPUP AND BEND
C D.RYAN 7/02 LAST REVISION: 12/OS/92
PARAMETER TTO-10, TTI-10. LPT-2. DSK«i
PARAMETER HAXN-120, MAXSM-23
COMMON /CJNX1/
1 IRPDT(4),KVOU<2). IFORHUO). IUBDT(4). IKSTO).
1 ISKPLEO2). IANLSTC4). ICONDO2). IACCNT(4). IPVTH<4),
1 ITHP<20>. ITXTOC). IACDT(4). IACDT2(4>.KUNITS<3>.NAM£<35).
1 KETH<2>. IP«TH<4>. IEXDT(4). IEXDT3(4>, ICKSTO).
I IRCBSU3). IC«NT(32>,NCOMP(2>, ICAS<6>. ICOUNT<73.2). IOADT(4),
1 NINO. ISAM?, IYR, I HO. I DAY, IMS. IMIN. ISEC. IX. ICP. ITYPE. ICHK. ICD.
t 1C. IEE. lERiNSARP. ICOOE. NPINO. IANS. I. 11.12. NW, NO. NN. IKOO. IUSE.
1 VOL. VEX. VINJ. FACTOR. CONC. 01. 02. 03. 04. Xi. X2. X3. X4. S3. X7, IOT. IRRT.
1 ftnOL. XHSL. A. 9. C. D. KEYD. RMEAN. SIGR. KEYR. XLSA2, SKEAN. SIGS. KEYS. AR.
1 XLCT. CREAN. SI8C, UEYC. IPHCT. ICH. LCH. HCH. ISPEC. MM. ID. LN. LNN.
1 ITOTAL. I6CNT. I7CNT. I2CNT. ISCNT. ICCNT. IFCNT. IQBKS. ISrtPLS
COMMON /CJNK2/
1 KCOCEC4). IEXTCC2). IEXTX(2>. IEXTR<2). IGCC<12>. INIT<2). IRRCH(9).
1 IRCAS(S). ICCTK2). IQCT2(2>. IQCT3<2>. ICCT4<2>, ISTRT(4). ISTQPC4)
COMHON /CJNK3/
1 IQCDSCdl). IQCFN(IO), IFLOSC(U). IFI_NK<8>. IFLFN(IO).
1 INLOSC(ll). INLNM(8>.LSTMO. IRRWK9). IRROT(4>. IOLNM. 13(11. MAXStl).
1 IQCLSU0.20>
COMKOH
I ZQCNW*?, IPRDT<4)
COMHON /CHAIN/
1 NPROC. IDFSW. IDFSWI, ITEMPdS).
1 IDFILE<12.6>. ISFILEU1.4),
1 INSTDO). IREFTABLE(tJ).
1 IAOD1. IAD02. ISUBt. ISU32- ISU33, ISUB4,
1 JA001.LIBRNAME.LIBRNUHB, IBUF.
I ISCN(4S). lACQ(lOO). IDAT<«3>
DATA IQCC/« LCL LWL AVE UWL UCL"/
"SU". "LT", "S ". °FI", "LE-, °NA". "ME'
"FX-.-CR". °NS"/
DATA IRRCH/-RE"
DATA MCODE/-UD"
DATA 1EXTC/". Q"
DATA IEXTX/". R"
DATA IEXTR/". R"
DATA IOCT3/-LS1 "/
DATA IOCT4/-LS2 "/
CALL NULSTUTMP. 1.20)
CALL NULSTdTXT. 1. 30)
C URITECTTO. 2) IRRNM, IRRDT
C2 FORMAT*" RRNAME: ". 9A2. " DATE: *,4A2>
C HRITECTTO, 6) IQLNM
C6 FORMAT*" IOLNM: ". 16)
00 20 I"l. IQLNtt
URITECTTO. 10>
-------
CALL cerriUYR, IKO. IDAY. IHR, IMIN. issc.sso. ix. ix. xx. xx, ix. ix>
IPRDTd>»dMO/10+4B)«2S6+«ODdMO. 10)4-43
IPRDT<2)-47«256+IDAY/10+48
XPRDT<3)»»256*47
XPRZ>T<4)»(KQDdYR/10. 10)+48>«256+KQDdYR. 10>+4B
ITMi»d)»»256+MODdYR. 10»4B
ITKP<2)-dHO/10+4a)«2SA*HODdMO. 10)+4S
ITKPC3)"dDAY/10*4S)»aS6+MODdDAY. 10>+48
ITW»<4>«dHR/10+48>»236+MODdHR. 10>+48
. XTRP<3)»dMIN/10+48>*2S6+MODdMIN. 101*48
C WHITEPLEASE SET TIME AT MSDS"
CALL LOAOITC-EXEC")
C FIND OUT IF FROM DMPP1 OR ELSEVACRE
C
140 IF.NE- ITMP(1» COTO 200 i YEAR
IF(IRRNM(2). NE. ITHP<2)> COTO 200 j MONTH
IFCIRRNMO). Nt. ITMP<3» COTO 200 » DAY
CALL VALUE(IRRKS1(4). 1, i. XI. 8200)
CALL VALUE(IRRf£1(9). 1. 1. X2. «200>
X3»X1»60. 0*X2
I2»INT(X3*0. 5)
IF«M-I2>. CT. 20) GOTO 200
IFUIOLNM. LT. 1). OR. (IQLNM. CT. 20)) COTO 200
HRITE"
CALL IN*»TS< IRRNH. ITMP. 9, «3040. »9020)
C ILEN-LENC (IRRNM. 9)
C XFdLEN. EQ. 10) COTO 420
410 HRITECTTO) " <7>FILE UNAVAILABLE"
COTO 400
C420 lER-TT.i
IER-77K
C CALL MAPSTdEXTX. 1.3. 2. IRRNM. 9. ll.«9000>
CALL OPENRdRRNM. MCH. IER. *SOO>
CALL CLOSE UCH. IER. »9000)
COTO 3000
500 CALL RESET
GOTO 410
C APPEND QC LIMITS ONLY IF FROM DKPP1
C
1000 IANS»"N<0>"
CALL INPTSC ITMP, IANS. 1. S8060, 63000)
IFdANS. EO. "N<0>"> GOTO 3000
XFdANS.ECJ. "Y<0>") COTO 1100
WRITECTTO) " <7>-
COTO 1000
145
-------
1100
1140
1190
1160
C
1162
1164
11EO
1190
C
C
1200
CALL OPENURRNM. MCH. IER. 09000)
CALL POSITIOWMCH. l.-l. -1, IER. »U40>
Il»0
Il-Il+l
CALL NULSTdGCFN, 1,10)
00 1160 I<=1.7
IQCFN (IQCFN(I). 1-1, 10). ICHR. I CODE
READ < LCH, 8100. END-11SO. ERR-1180) dTHPd ). IF!, 7). NM.NQ, NN.
IQCFN
CALL CLOSE (LCH, IER. 91990)
OOTO 1990
00 1900 IND-l.NM
READ(LCH, 8140. END-1 180. ERR-1180) INOO. . 1-1, 35)
READCUCH. 8160. END-1 ISO, ERR-1180) < ICAS( I). !•!. 6). 1USE.
RMDL, XMDL. A. B. C. D. KEYD
READ (LCH, 8180. END-1 180. ERR»1 180) RHEAN. SIGR. KEYR, XLSA2.
SMEAN, SI OS, KEYS. XLCT, CMEAN, SICC. KEYC
IFdNO. ME. INDO) GOTO 1180
COMPRESS CAS NUMBER
IRCAS(3)»ICAS<6>
ICHAR-NCHARdCAS. 6. iO)
CALL MOVBTi ICHAR, IRCAS. 6. 9. 61890)
ICHAR-NCHAR ( ICAS. 6. 9)
CALL NOVBT< ICHAR. IRCAS, 6. 8. *1B90>
ICHARoNCHAR ( ICAS, 6.7)
CALL KOVBT< ICHAR. IRC^S, 6, 7. »1890)
IRCAS(3)-ICAS(3)
!RCAS(2)-XCAS<2>
IRCAS(l)-ICASd)
CALL NULST "
IFdCH. NE. "C ") ICHR-"M "
ITMP(2)— UP"
ITKP(5)-" A"
WRITE
-------
c
c
1400
C
C
1900
C
C
1600
C
C
1800
1840
SPIKES
IFCIUSE. EG. 3) GOTO 1900
X1"SH£AN-2»SIGS+D3
X2-SMEAN-SICS+D3
X3-SMEAN+D3
X4-SMEAN+SICS+D3
X3-SMEAN+2*SIC8+D3
ICHR-WEYS AND. 177400K). OR. "<0> "
IT«P(1)-HLS"
ITMP<2)-"PK"
GOTO 1840
SURROGATE SPIKES
IFCIUSE. NE. 2> GOTO '900
X1«SHEAN-2»SIGS+D3
X2-SMEAN-SICS+D3
X3-SHEAN+D3
X4-SMEAN+SICS+D3
X3-S«£AN+2*S I GS+D3
ICHS- "
ITHP(2>«»"SP"
GOTO 1B40
CONTROL STANDARDS
IFtXLCT. LE. DO) GOTO 1900
X1-CMEAN-2»SIGC+D3
X2"CMEAN-SIGC*D3
X3-CMEAN+D3
X4-CMEAN+SICC+D3
ICHR- "
ITHP<1)""LC"
ITMP«2)°"ST"
GOTO 1S40
REAGENT BLANKS
X1«RHEAN-2»SICR+D4
X2-RMEAN-SIGR+D4
X3-RMEAN+D4
X4-RMEAN+SIGR+D4
X 5«RMEAN+2*S I CR-i-04
ICHR-(KEVR. AND. 177400K). OR. "<0> "
XTHP(l)-"Ul"
ITMP(2)-"BL"
ITMP(S>-" L"
ITHP(6>-"CL"
IF< ICHR. NE. "C ") ICHR-"M "
WRITE
ITKPO)-" U"
ITMP<6)-"WL"
WRITE(MCH, 8200) (ITMP(I), I«i,6), IRCAS, X4, ILBDT, ICHR,
(lOCFN(J). J-l. 5)
ITMP(6)«"CL"
WRITE(MCH, 8200) (ITKPd), 1-1,6), IRCAS, XS. ILBDT. ICHR,
(IQCFN(J), J-l- 5)
GOTO 1900
147
-------
1890 WHITECTTO) " <7>£RROR!"
1900 CONTINUE
CALL CLOSEMAJOR ERROR!"
SOOO IFU1.EO. IOLNM) GOTO 2020
GOTO 1150
2020 CALL RESET
C CALL CLOSE(MCH, IER. 99000)
C OUTPUT OPTIONS
C
3000 WRITE(TTO, B300>
IOMD-"T<0>"
CALL IH4PTSC ITHP. IOMD. 1. *8320. *50OO)
IFIIOMD. EQ. "T<0>M> GOTO 3100
IFCIQHD. EQ. "N<0>") GOTO 3200
XFCIOHB. EQ. "P<0>"> GOTO 3800
WRITECTTO) « <7>HRONC MODE"
GOTO 3000
C OUTPUT RUN RESULTS TO MAG TAPE
C
3100 IFLFNC1)--MT"
IFLFNC2>«": #"
CALL NULST(IFLFN, 5. 10)
WRITECTTO. 3340)
ITMP(1>="1<0>"
CALL INPTSfIANS.ITMP.1.*8360,43000)
IFLFN(3)»IANS
KCHAN»DSK
CALL OPENW< iVUFN. KCHAN, IER. «3J40)
CALL OPENRURRNM, MCH, IER. »3120>
CALL FCOPY(MCH. KCHAM, *3120. IE. IER>
3120 CALL CLOSE(MCH,IE)
CALL CLOSE WHITECTTO.8420) IER
IrUER. EO. 37K) WRITECTTO. 8440) IER
IFdER. EQ. 50K) WRITECTTO. 8460) IER
IF< IER. OT. 30K. AND. IER. LE. 61K) WRITECTTO. 8480) IER
GOTO 3000
C OUTPUT RUN RESULTS TO NOVA VIA MICRO
C
3200 CALL NULSTCITMP. 1.40)
:STRTC1)--ST"
ISTRTC2>-"AR"
X8TRTC3)-"T<0>"
ISTRTC4)-O
ISTOPC1)--8"
IBTOPC2>-"OM"
ISTOP<3)-"B<0>M
ISTOPC4)-O
WRITECTTO. 8560)
ITMP<1>-"CR"
CALL INPTSUANS. ITMP. 1.98980. »3000)
WRITECTTO. 8620)
WRITECTTO. 8640) ISTRT
148
-------
C3340 READ(ICH. 8630. END-3420.ERR-3420> , 1-1, 40>
C DO 3360 J»I. 40
C I1-4O-J*!
C IFdTXTdl). N£. " "> COTO 3380
C ITXT°0
C33iO CONTINUE
C33SO K-I1*2
C ICKR1«NCHAR(ITXT.40.K>
C IFUCHRl.NE. 20000K) GOTO 3400
C mmn-ITXTdl). ANO. 177400X
C K-K-i
C
C3400 WRITECrrO. 8660) dTXTd >. 1-1. 40)
C
C COTO 3340
CALL OPENRdRRNM. MCH. IER.*3500>
CALL FCOPYtMCH. TTO, IER. *3420, IE, IEfl>
3420 CALL CLOSE(MCH. IE)
3900 WRITE(TTO.8680) I6TOP
CALL CLOSE(fICH. IE)
WRITE(TTO,8820)
COTO 5000
C OUTPUT RUN RESULTS TO THE POP 11/70 MICROPROCESSOR INTERFACE
C
3800 WRITE(TTO) " <7>PDP ll<57>70 TRANSFER NOT AVAILABLE. "
GOTO 3000
5000 IANS-"N<0>"
CALL INPTSdTMP. IANS. 1. *890Q. «5300)
IFdANS. EO. "N<0>") COTO 5300
IFdANS. EO. "Y<0>"> GOTO 5100
WRITE(TTO) • <7>M
GOTO 9000
9100 KCHAN-LPT
CALL OPLPTCKCHAN,*5200)
CALL OPENRdRRNM, MCH. IER. 85200)
CALL FCOPY(HCH. KCHAN. *S200. IE. IER)
9200 CALL CLOSE(MCH.IE)
CALL CLOSE(KCHAN, IEE>
9300 IANS«"N<0>"
CALL INPTSdTMP, IANS. l.«8920.*S700)
IFdANS. £0. mN<0>a) COTO 9700
IFdANS. EQ. HY<0>«) GOTO 9400
WRITE(TTO) • <7>«
GOTO 9300
9400 CALL DELETE(IRRNM.IER. S9000)
9700 CALL RESET
CALL LOADITCDKPC")
149
-------
8000
1
8020
B040
8060
6090
8100
8120
8140
8160
6180
8SOO
8300
1
. 1
1
8320
8340
8360
83SO
8400
8420
8440
8460
8480
C8540
8560
8980
8620
8640
C86SO
C8660
36". /•
" RUN RESULTS FILE NAME: ".9A2>
FORMATC ".A" RUN RESULTS SEND MODULE (DMPP2)"./>
FORMATC ENTER COMPLETE FILENAME C".9A2. "3 > "• Z)
FORMATC APPEND OC LIMITS TO RR FILE C",A2. "3 > ".Z)
FORMATC OPEN QCO7>MT: ", 10A2." CODE: ",A2. " ICODE: ". 16)
FORMATC7A2.3I4. 16A2. IX)
FOHMATC <7>UNABLE TO PROCESS OC<37>KETHOD TEMPLATE FILE ". 10A2)
FORMAT(13. IX, 3SA2> 2X >
FOSMAT<6A2. IX, 13. 1X.2F7. 2. IX. 4FIO. 3.A1. IX)
FORMAT(2F7. 2.A1,2(F8. 2.2F6. 1,A1).1X>
FORMATC 4 °.6A2. " C", 5A2. IX.EtO. 3. IX, 4A2. IX. A2, 11X, 3A2. 10X)
FORMATC RUN RESULTS OUTPUT OPTIONS:"./.
" T - COPY TO TAPE". /,
" N - SEND TO NOVA VIA MICRO BUFFER". /.
" P - SEND TO POP 11/70 VIA MICRO DUFFER")
FORMATC" OPTION C".A2. "3 > ".Z)
FORMATC/. • <7>HOUNT MAG TAPE AND INITIALIZE. ")
FCRMATC OUTPUT RR FILE TO MT:# C".A2. "3 > ".Z)
FORMAT<° <7>DISMOUNT TAPE AND RECORD RR FILES OUTPUT")
FORMATC <7>FILE DOES NOT EXIST. ERROR: °,OI4>
FORMATC <7>IMPROPER TRACK NUMBER. ERROR: ",014)
FOHMAT< " <7>TAPE UNIT IN USE. ERROR: ".014)
FORMATC C7>TAPE UNIT NOT READY. ERROR: ".016)
FORMATC <7>OENERAL TAPE ERROR: ".0:4)
FORMATC <7>FILE ACCESS ERROR: ".OI6)
FORMATSWITCH ON MICRO INTERFACE BOX")
FORMATC PRESS RETURN WHEN READY t".A2. "3 > ". Z)
FORMATC 1°)
FORMAT (IX. 4A2)
FORMAT(40^2)
FORMAT UX.40A2)
FORMAT(1X.4A2)
FORMATCl<7>TASK COMPLETE. TURN OFF INTERFACE NOW"./)
FORMATC OUTPUT RUN RESULTS TO LINEPRINTER C".A2."3 > ".Z)
FORMATC DELETE RUN RESULTS FILE FROM DISK C".A2."3 > ".Z)
WRIT£(TT0.9010) IER
FORMATC" <7>ERROR FATAL:
CALL RESET
CALL LOADIT("EXEC")
END
-.014)
150
-------
SUBROUTINE FLCHXUFILE. KURDS. INFRT, IERTN, IER)
C THIS ROUTINE SCANS THE DISK DEVICES TO FIND IFILE.
C IP D: IFILE IS FOUND. THE ROUTINE RETURNS NORMALLY
C 4*0 IFILE IS MODIFIED TO CONTAIN THE PROPER DEVICE
C ATTRIBUTE IN SPECIFIER FORM. IF THE DISK DEVICES ARE
C EXHAUSTED BEFORE IFILE IS FOUND. IFILE IS RETURNED
C UNCHANGED AND THE RETURN IS TO INFRT (NOT FOUND).
C IF AN UNEXPECTED ERROR IS DETECTED. IFILE
C IS RETURNED UNCHANGED AND THE RETURN IS TO IERTN.
C IER HILL BE SET TO THE APPROPRIATE VALUE.
COMMON JFLNM (20)
INTEGER IFILE(MHRDS)
DO 10 1-1,8
JFLNM(I)-0
10 CONTINUE
DO 100 I-l.MWRDS
JFLNM< 1*1 )-IFILE( I )
100 CONTINUE
300 CALL RENAME C JFLNM. JFLNM. IER. 8300)
300 IFOER. LT. 0) IER— IEH
IFdER. EO. 36K) GOTO 500 (ALREADY EXISTS
IFUER. EQ. 30K) GOTO 700 * DEVICE NUMBER EXCEEDED
IFCIER.NE. 22K> GOTO 900 I UNEXPECTED ERROR
JFLNmi>-JFLNmi)-KCOK I INCREMENT DEVICE »
GOTO 200
tr
900 DO 600 I-l.MWRDS
IFILE(I)-JFLNM(IJ
600 CONTINUE
RETURN
700 RETURN INFRT I NOT FOUND
900 RETURN IERTN i ERROR
END
151
-------
SUBROUTINE 008BUNSTRNC. MWRDS. LENN)
C
C THIS SUBROUTINE GOBBLES UP BLANKS AT THE DECINNING
C AND AT THE END OF STRING NSTRNO AND RETURNS THE
C REMAINING STRING. ISPC IS A LEFT JUSTIFIED SPACE.
C IT IS REPLACED WITH ICHRO WHICH IS A NULL. LENN IS
C RETURNED AS THE LENGTH OF THE REMAINING STRING.
C
C USES LENC- NCHAR, NULST, AND MOVST
C
INTEGER NSTRNO(KURDS)
ICHRO«0
LENN-0
ISPC-2OOOOH
LENN»LENO(NSTSNG. MWRDS)
IF(LENN. Ed. 0) RETURN
I2-LENN
DO 100 II-l.LENN
ICHR1«NCHAR(NSTRNC, MWRDS.ID
IFUCHR1.NE. ISPC) GOTO 300
100 CONTINUE
LENN-0
CALL NULST(NSTRNO.l.MWRDS)
RETURN
300 ICHH1«NCHAR(NSTRNG. KURDS. 12)
IFdCHRl. NE. ISPC) GOTO 40O
I2-12-1
GOTO 300
400 LENN-ia-Il+1
C
C THIS MOVES A STRING INTO ITSELF
C
C CALL MOVST(NSTRNG. II. 12. HWRDS. NSTRNG. MWRDS. -1. *700>
C RETURN
13-0
DO 900 1-11,12
I3-I3+1
ICHR1-NCHAR(NSTRN3. MW9DS, I)
CALL MOVBT( ICHR1. NSTRNG, riWHDS. 13, »700>
900 CONTINUE
CALL NULST(NSTRNG.LENN*1,MWRDS)
RETURN
700 WRITE(IO) " <7>COBBL FAILURE-
RETURN
END
152
-------
SUBROUTINE INPTHNEHINT.LASTINT, IFORMAT. IEND)
C
C INPTI PROMPTS THE USER CM THE CONSOLE USING
C A FORMAT SUPPLIED BY THE CALLING PROGRAM AND TYPES
C AN INTEGER NUMBER WHICH REPRESENTS THE DEFAULT RESPONSE.
C INPTI THEN GETS AN INTEGER NUMBER FROM THE CONSOLE
C IF ONE IS TYPED. IF NO NUMBER IS FOUND. THE SUBROUTINE
C USES THE DEFAULT NUMBER. ERROR RETURN ON CTRL-D
C
C ARGUMENTS ARE:
C NEUINT - CET EQUAL TO INPUT OR 'DEFAULT NUMBER
C LASTINT » LAST NUMBER (DEFAULT ON NULL RESPONSE)
C IFORMAT - (M-ABEL OF FORMAT STATEMENT IN CALLING PROGRAM
C IEND « 8LABEL FOR RETURN WHEf CTRL-D STRUCK
COWN3N INPUTUO)
WRITE<10. IFORMAT) LASTINT
READ( 10. 10. END-20. ERR-20) INPUT
JO FORMAT<10A1)
IFLG»0
ISCN-l
. NEUtNT-0
K-0
DO 19 1-1, 1O
J-INPUTU)
IF(J. EQ. " ") GO TO 15
IFdFLG. EO. 1) CO TO 11
IF(J. NE. "- ". AND. J. Nt. "+ •) CO TO 11
IFL6-1
IF(J. EQ. "- "> ISCN«-ISCN
CO TO 15
11 IF(J. LT. "0 ".OR. J. ST. "9 ") GOTO 18
K-J/256
NEWINT-10»NEWINT+K-6OK
13 CONTINUE
IS NEUINT«I3IGN(NEWINT. IS5NI
IF(K.EQ. 0) NEW I NT-LAST I NT
LASTINT-NEWINT
RETURN
20 RETURN IEND
END
153
-------
SUBROUTINE INPTF
IF(K. EQ. 0) XNEWVL-OLDVAL
OLDVAL-XNEWVL
RETURN
RETURN IEND
END
154
-------
SUBROUTINE ,INPTS(NEU3TR. LASTSTR, LENGTH. IFORMAT. IENO)
C INPTS PROhPTS THE USER ON THE CONSOLE DEVICE USING A FORMAT
C SUPPLIED BY THE CALLING PROGRAM AND TYPES AN ALPHANUMERIC
C STRING WHICH REPRESENTS THE DEFAULT ANSWER TO THE PROMPT.
C THE SUBROUTINE THEN GETS A CHARACTER STRING FROM THE CONSOLE AND.
C IF IT NOT BLANK. STORES IT IN THE ARRAV IN THE CALLING PROGRAM.
C IF THE STRING IS NULL OR ALL BLANKS. THE DEFAULT ANSWER IS USED.
C
C ARGUMENTS ARE:
C NEWSTR • ARRAY FOR ANSWER
C LASTSTR «• PREVIOUS ANSWER
C LENGTH " NUMBER OF WORDS IN ARRAY
C IFORMAT - »LA3EL OF FORMAT STATEMENT IN CALLING PROGRAM
C IEND " CLABEL FOR RETURN WHEN CTRL-D HIT.
C
C INPTS USES FUNCTION NCHAR.
C
COMMON INPUT(40)
INTEGER NEWSTR(LENGTH),LASTSTR(LENGTH)
WRITE(10.IFORMAT) (LASTSTR(I), 1-1.LENGTH)
READ< 10. 10, END-20) INPUT
10 FORMAT(40A2)
C
C LIN-LENG(INPUT, LENGTH)
C WRITEdO. 1000) (INPUT( I), 1-1.40). LIN
C1000 FORMATC INPUT « ".40A2, " WITH LENGTH - ".13)
C
DO 1 J-l-40
I-40-J-H
IF(INPUTU). NE. " ") GO TO 3
1 INPUTU>«O
DO 2 I-1. LENGTH
2 NEWSTR(I)-LASTSTRU)
RETURN
3 K»I*2
ICHR1-NCHAR (INPUT, LENGTH. K>
IFdCHRl. NE. 20000K) CO TO 4
INPUT(I)-INPUTd). AND. 177400K
4 DO S 1-1.LENGTH
LASTSTR(I)"ZNPUT(I)
9 NEWSTR(I)-INPUT(I>
RETURN
20 RETURN IEND
END
155
-------
FUNCTION UENCCNSTRNC. HWRDS)
C
C THIS FUNCTION RETURNS THE LENGTH OF NRSTRNC. CHARACTERS
C ARE EXAMINED UNTIL TK£ FIRST NULL IS ENCOUNTERED.
C CHARACTERS FOLLOWIN« THE FIRST NULL ARE DISREGARDED.
C
C USES FUNCTION ISHFT. NCHAR
C
INTEGER NSTRNC(MWRDS)
LENC-0
IBTLN-2*MWRDS
1-0
too 1-1*1
IHQRD-d+n/2
IMO"U-MOD
-------
SUBROUTINE MAPST{INSTR, ISTRT, ISTOP, NWRDS, NSTRNC, MWRDS. MBYTE. IERTN)
C
C THIS SUBROUTINE MAPS STRING INSTR ONTO STRING NSTRNO AT
C POSITION NBVTE. THIS ROUTINE WILL WRITE IN NULL SPACE.
C
C USES NfHAR, LENO, AND MOVBT
C
INTEGER INSTR(NURDS).NSTRNO(MURDS)
IF(NBYTE. LE. 0) GOTO 700
NBYT-NBYTE
LENI=LEN8(INSTR. NURDS)
IF (LENi.LE. o> RETURN
IF (ISTRT. LT. 1. OR. ISTRT. CT. LEND COTO 700'
IF (ISTOP. CT. LEND ISTOP-LENI
IF (ISTOP. LT. ISTRT) GOTO 700
LENN-LENC(NSTRNG. MWRDS)
IF (NBYT. CT. (HWRD5»2» COTO 700
C
C WRITE INSTR INTO OR ONTO NSTR
C
DO 300 I-ISTRT, ISTOP
ICH-NCHAR{INSTR,NURDS,I)
IBT-NBYT*I-ISTRT
CALL KOVBT( ICH, NSTRNG. MWRDS. IBT. «700)
3OO CONTINUE
RETURN
700 RETURN IERTN
END
157
-------
SUBROUTINE HOV/BT
IFdBVTE. LE. 0) GOTO 700
IWORD-
-------
SUBROUTINE HOVST(INSTR. ISTRT. I STOP, NURDS. NSTRNG, KURDS. NBYTE, IERTN)
C
C THIS SUBROUTINE MOVES STRING INSTR INTO STRING NSTRNO AT
C POSITION NBYTE. THREE VARIATIONS ARE POSIBLE DEPENDING
C ON THE VALUE OF NBYTE:
C NBYTE > 0 INSERT INSTR INTO NSTRNC AT NBYTE
C NBYTE " 0 APPEND INSTR ONTO NSTRNC
C KBYTE < 0 OVERWRITE INSTR INTO NSTRNG AT NBYTE
C
C NBYTE IS RETURNED AS THE LENGTH OF THE RESULTIN3 STRING
C USES NCHAR, LENC. AND MOVBT
C
INTEGER INSTR(NWRDS).NSTRNO(HWRDS>
ICHROaO
NflYT-NBYTE
LENI-LENO(INSTR.NURDS)
IF (LENI.LE. 0) RETURN
IF (ISTRT. LT. I. OR. ISTRT. CT. LEND GOTO 700
IF (ISTCP. OT. LENI) ISTOP-LENI
IF (ISTOP. LT. ISTRT) GOTO 700
LENN-LENG(NSTRNO. KURDS)
IF (NBYT. LT. 0) NSYT—NSYT
IF (N8VT. GT. > GOTO 700
C ROUTE FOR OVERWRITE. APPEND. OR INSERT
IF (NBYTE) 200. 150. 100
100 IF (LENN. EQ. 0> CO TO 150
C SPREAD SEGMENTS OF NSTRNG TO ALLOU INSERTION OF INSTR
I-LENN
.110 ICH-NCHAR(NSTRNC.KURDS. I)
IBT-I+ISTOP-ISTRT+1
CALL MOVBT< ICH, NSTRNG. KURDS. 1ST. 9700)
1-1-1
IF (I.GE. NBYT) GO TO 110
CO TO 200
C APPEND INSTR TO NSTRNO AT NBYT
. ISO NBYT-LENN+1
C WRITE INSTR INTO OR ONTO NSTR
200 DO 300 I-ISTRT.ISTOP
ICH-NCHAR(INSTR. NURDS. I)
IBT-NBYT+l-ISTRT
CALL MOVBT(ICH, NSTRNC. KURDS. I3T, 9700)
300 CONTINUE
IF(NBYTE. LT. 0) GOTO 400
NBYTE-NBYT+ISTOP-ISTRT
RETURN
C CLEANUP AFTER OVERWRITE
400 NBYTF-IBT
IFdBT. CE. LENN) RETURN
IBT-IET+1
DO 500 1-IBT.LENN
CALL MOVBT(ICHSO, NSTRNG. KURDS. I. «700)
900 CONTINUE
RETURN
700 RETURN IERTN
END
159
-------
SUBROUTINE NC AS (ISTRN. KURDS. I ERTN)
C THIS FUNCTION GOBBLES THE SPACES AROUND STRING ISTRN
C AND THEN CHECKS THE CAS NUMBER TO DETERMINE
C IF IT IS LECITIPIATE. IERTN IS TAKEN FOR INVALID CAS COOES.
C KCA8 USES NCHAR AND CCSBL.
INTEGER ISTRN(HWRD3>
IF(MWRDS. NE. 6) GOTO 700
CALL 80BBLC IBTRN. KURDS. LCAS)
IFULCAS. LT. 4). OR. (LCAS. CT. 11)) COTO 700
1CHR«NCHAR( ISTRN. KURDS. LCAS)
ICHKO-ICKR/236-48
ir« ICHKO. LT. 0).OR. (ICHKO. OT. 9)) COTO 700
ISTRN(6)-ISHFTUCHR.-8).OR.
ISUM-0
IPOS«11
I-l
200 LCAS-LCAS-1
IF(LCA3. LE. 0) COTO 400
ICH-NCHAR( ISTRN, KURDS. LCAS)
IFUICH. EQ. " <0>").OR. (ICH. EQ. *-<0>")> COTO 200
IDIOICH/296-49
IF«IDIO. LT. 0>.OR. (IDIC. CT. 9» COTO 700
ISUM-ISUH+IDIC*!
I-I+l
300 IPOS-IPOS-1
CALL MOVBT( ICH. ISTRN. KURDS. IPOS. 9700)
IF (IPOS. NE. 9) COTO 200
ICH-"-CO>"
COTO 300
400 ICH-" <0>"
IPOS-IPOS-1
DO 500 J-l, IPOS
CALL KOVBT( ICH. ISTRN, KURDS, J. *700)
5OO CONTINUE
IFdPOS. CT. 6) COTO 700
ICHHl-MODdSUM, 10)
IF ( ICHKO. NE. ICHKl) COTO 700
RETURN
700 RETURN IERTN
END
160
-------
FUNCTION NCHAR/2
IFUMQRD.OT. KURDS) RETUrtN
II-ISHFT(hSTfINO(lWORD).e»
-------
FUNCTION NPOS< INSTR, NURDS. NSTRNC. MWRDS. I BYTE)
C
C THIS FUNCTION RETURNS THE STARTING POSITION OF THE OCCURRENCE
C OF JNSTR IN NSTHNO STARTING WITH POSITON IBVTE IN NSTRNC. THE
C FUNCTION RETURNS THE FOLLOW INS VALUES:
C
C NPOS » 0 IF INSTR NOT FOUND IN NSTRNC.
C NPOS > 0 INDICATING THE BYTE POSITION OF THE START OF
C INSTR IN NSTRNC.
C
C USES LENO. ISKFT. AND MOD
C
INTEGER NSTRNO(RWRDS). INSTR(NUnDS)
NPOS-0
LENI-CENQ< INSTR. NVRDS)
IFCLENI.EQ. 0) RETURN
LENB-2*MWRD5
IF( IBYTE. LE. 1 ) IPOS-0
IF( IBYTE. CT. t ) IPOS-IBYTE-1
100 ILEFT-LENB-IPOS
IF (LENI. CT. ILEFT) RETURN
C
• C FIND OUT IF INSTR IS IN NSTRNO STARTING AT IPOS
C
DO 200 I-l.LENI
IX-IPOS+I fc
IMD-KODdX.2)
ICHR1-ISHFT(NSTRNO(IWORD),-B»IMD). AND. 377K
IWORD-(I+l)/2
IMD-MQD(T.2)
ICHR2»ISHFT{INSTR(IWORD).-8«IMD>. AND. 377K
IFCICHP1. EQ. ICHR2) GOTO 200
IPOS-IPOS+1
GOTO 100
200 CONTINUE
C
C SUCCESS - STRING FOUND
C
NPOS- IPOS* 1
RETURN
END
162
-------
SUBROUTINE NULST ISTBT»1
IWDST«/2
IFIIWDST. OT. MWRDS) RETURN
11-MOD(ISTBT. 2)
IFdI.EQ. 0) NSTRNC-NSTRNG(IHDST). AND. 177400K
IFdI.EQ. 1) NSTRNO!IWDST)-O
IFdHDST. EQ. MWSDS) RETURN
It-IHDST-t-1
DO 10O loIl.MMRDS
100 CONTINUE
RETURN
END
163
-------
SUBROUTINE PADSTfNSYRNC. MWSDS)
C THIS SUBROUTINE WILL PAD A STRINO WITH BLANKS
C FROn THE FIRST NULL UP TO THE HWRDS»2 BYTE.
C USES HOD. AND LENC SUBROUTINES.
INTEGER NSTRNO(MWf)DS)
IBYT«CENO*-1
IWRO-UBYT+n/2
IFdWRD. OT. MWBDS) RETURN
II=«DD(IBYT, 2)
IFt-IJ. EQ. O) NSTRNG(It!RD>-NSTRN«(IWRD>. OR. 40K
IFdI.EO. 1) NSTRNfl(IHRD)=20O40K
IFdURD. EQ. RWRDS> RETURN
DO 100 I-I1. MfcB?CS
100 CONTINUE
RETURN
END
-------
SUBROUTINE QCTSmCONC.XMEAN,XSIC.XKNWN.IQMSG.PREC)
C QCTST COMPUTES A PERCENT RECOVERY WITH XCONC AND XKNWN
C FOR SPIKES AND CONTROL STANDARDS. IF XKNWN. LE. 0. 0 THEN
C THE ROUTINE ASSUMES A REACENT BLANK WAS RUN AND PREC IS
C SET TO XCONC. IF APPLICABLE. QCTST THEN COMPARES THE PHEC
C WITH THE CONTROL LIMITS COMPUTED FROM XMEAN AND
C XSIO. IQMSO IS ASSIGNED THE VALUE OF "NO"
C IF THE PREC IS GREATER THAN 3*XSIO FROM XMEANi
C "WR" IF PREC IS BETWEEN 2 AND 3»XSIO FROM
C XMEANi AND "OK" IF PREC IS WITHIN 2»XSIO
C OF XHEAN.
C
C USES FUNCTION A8S
IGMSO-"NO"
IFOT. 0.0001) GOTO 100
PREC»XCQNC
GOTO 200
100 PREC-100. 0*XCONC/XKNUN
200 TEST-ABS(PREC-XMEAN>
IF(TEST. LE. (3. 0»XSIO>) IQ«Se-"HR"
IF (TEST. LE. (2. 0*XSIO> > IGMSG»"OK*
RETURN
END
165
-------
SUBROUTINE VALUE(NSTRMC. KURDS. ISTRT, VAL. IERTN)
C
C THIS FUNCTION TAKES NSTRNO AND CONVERTS IT TO A FLOATING
C POINT NUMBER. THE ROUTINE FINDS THE FIRST POSSIBLE NUMBER.
C ANY TRAILING NON-NUMERIC CHARACTERS TRIGGER AN EXIT. AN
C IERTN IS TAKEN IF NO DIGITS ARE ENCOUNTERED.
C
C USES FUNCTION NCHAR
C
INTEGER NSTRNG"> GOTO 300
IFdFLO. EQ. I) GOTO 100
IF< J. NE. "-<0>". AND. J. NE. "*<0>" ) GOTO 100
IFLC-1
IF(J. EQ. "-<0>") ISGN—ISGN
GOTO 300
100 IFU. NE. ". <0>") GOTO 200
IDEC-1
GOTO 400
800 IF". OR. J. GT. "9<0>") GOTO 600
K-J/236
VAL"10. 0*VAL+FLOAT(K-60K)
3OO CONTINUE
GOTO 600
400 DEC-1.0
I-I+l
DO 900 Il-I, ISTOP
J«NCHAR(NSTRNO. KURDS. ID
IF(J. LT. "0<0>". OR. J. GT. «9<0>"> GOTO 600
DEC-DEC*10. 0
K-J/256
VAL-VAL*FLOAT < K-60K)/DEC
5OO CONTINUE
600 IF(K. EO. 0) GOTO 700
VAL«SIGN(VAL. FLOAT(ISON))
RETURN
700 RETURN IERTN
END
166
-------
-------