SUBROUTINE ZPDRK C C Module Number: 13.5 C C Module Name: ZPDRK C C Keyphrase: C ---------- C HRS particle hits and dark count C C C Description: C ------------ C This routine finds particle hits and computes the dark count C from input dark observation(s). Particle hits are identified C by the count rate in a diode being greater than a specified C threshold (PTHRSH) above the average count rate for the diode. C If PTHRSH is not specified (i.e. equals 0) then a threshold C is computed for the diode as PNSIG times the standard deviation C of the count rates for the diode. A optional data quality mask C can be used to flag bad diodes which should not be considered C in the particle hit identification process. C The routine then computes the average dark rate per frame of C data and per diode. Data values determined to be particle hits C are not used in the computation of the dark rates. C Noisy diodes are identified as ones where the average dark rate C is greater than a specified threshold (DTHRSH) above the average C dark rate for all diodes. IF DTHRSH is not specified (i.e. equals C zero) than a threshold is computed as DNSIG times the standard C deviation of the dark rates in the average for all diodes. C C C FORTRAN Name: ZPDRK.for C C C Keywords of Accessed Files : C -------------------------- C C input input input dark count observations C eetrailer input ext. eng. trailer file C mask input input data quality masks C table1 output output event summary table C table2 output output frame summary table C dark output output dark count vector C C Modules Called: C --------------- C CDBS: C zpd1, zpd2, zpth, zdark, zpdsum C SDAS: * uclgs* , umsput * uttinn, utppti, utcdef, utrpt*, utcpt*, uthad*, uttclo, utccre * uttopn, utpgti, utcfnd, utrgt*, utcgt*, uthgt*, uttclo * uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo C OTHERS: C C History: C -------- C Version Date Author Description C 1 8/20/86 D. Lindler Designed and coded C 2 AUG 88 D. LINDLER Added first_diode to event table C------------------------------------------------------------------------ C DATA DECLARATION C C INCLUDE FILE FOR THE IRAF77 FORTRAN INTERFACE TO THE IRAF VOS C C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER RDWRIT PARAMETER (RDWRIT = 2) INTEGER WRONLY PARAMETER (WRONLY = 3) INTEGER APPEND PARAMETER (APPEND = 4) C C CODES FOR DATA TYPES C INTEGER TYBOOL PARAMETER (TYBOOL = 1) INTEGER TYCHAR PARAMETER (TYCHAR = 2) INTEGER TYINT PARAMETER (TYINT = 4) INTEGER TYREAL PARAMETER (TYREAL = 6) INTEGER TYDOUB PARAMETER (TYDOUB = 7) C C UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87 C INTEGER STDOUT PARAMETER (STDOUT = 1) INTEGER STDERR PARAMETER (STDERR = 2) C C UHDAS HEADER PARM TYPES -- CB, DAO, 5-SEP-87 C INTEGER GENHDR PARAMETER (GENHDR = 0) INTEGER IMSPEC PARAMETER (IMSPEC = 1) C C THIS SECTION IS FOR PARAMETERS RELEVANT TO TABLE I/O. C C THESE MAY BE SET BY UTPPTI AND/OR READ BY UTPGTI: C C LENGTH OF ROW (UNIT = SIZE OF REAL) INTEGER TBRLEN PARAMETER (TBRLEN = 1) C INCREASE ROW LENGTH INTEGER TBIRLN PARAMETER (TBIRLN = 2) C NUMBER OF ROWS TO ALLOCATE INTEGER TBALLR PARAMETER (TBALLR = 3) C INCREASE ALLOC NUM OF ROWS INTEGER TBIALR PARAMETER (TBIALR = 4) C WHICH TYPE OF TABLE? (ROW OR COLUMN) INTEGER TBWTYP PARAMETER (TBWTYP = 5) C MAXIMUM NUMBER OF USER PARAMETERS INTEGER TBMXPR PARAMETER (TBMXPR = 6) C MAXIMUM NUMBER OF COLUMNS INTEGER TBMXCL PARAMETER (TBMXCL = 7) C TYPE = ROW-ORDERED TABLE INTEGER TBTYPR PARAMETER (TBTYPR = 11) C TYPE = COLUMN-ORDERED TABLE INTEGER TBTYPC PARAMETER (TBTYPC = 12) C C THESE MAY BE READ BY UTPGTI BUT MAY NOT BE SET: C C NUMBER OF ROWS WRITTEN TO INTEGER TBNROW PARAMETER (TBNROW = 21) C C END IRAF77.INC C C ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTAT,ISTATS(20) C --->STATUS INDICATOR CHARACTER*130 CONTXT C --->STATUS MESSAGE C C INPUT FILE I/O C CHARACTER*130 INPUT,NAME,MASKT,MNAME,EETEMP,EENAME INTEGER IDTEMP,IDTMP2,IDTMP3,IDIN,IDIN2,IDIN3, * NAXIS,DTYPE,DIMEN(8),NS REAL DMASK(500),DATA(500),ET(24) C C OUTPUT TABLE1 (EVENT TABLE) C CHARACTER*64 TABLE1 INTEGER IDOUT,COLIDS(9),CTYPE1(5) CHARACTER*20 CNAME1(5),CUNIT1(5) C C OUTPUT TABLE2 (FRAME SUMMARY) C CHARACTER*64 TABLE2 INTEGER CTYPE2(9) CHARACTER*20 CNAME2(9),CUNIT2(9),CFORM(9) C C OUTPUT DARK FILE C CHARACTER*64 DNAME C C WORK AREAS C REAL SUM(500), C --->SUM OF DATA & SUMSQ(500), C --->SUM SQUARED OF DATA & CPERE(10000), C --->COUNT PER EVENT & DPERE(10000), C --->NUMBER OF DIODES PER EVENT & EVENTS(10000), C --->NUMBER OF EVENTS/FRAME & EXPO(10000), C --->EXPOSURE PER FRAME & DIODES(10000), C --->NUMBER OF DIODES/FRAME & ARATE(10000), C --->ANTI-COIN. RATE PER FRAME & BRATE(10000), C --->BACKGROUND RATE PER FRAME & RRATE(10000), C --->RADIATION DIODE RATE PER FRAME & DRATE(10000), C --->DARK RATE PER FRAME & PRATE(10000), C --->PART. COUNTS PER FRAME & ONED(10000), C --->SINGLE DIODE DARK RATE/FRAME & PTA(500), C --->PARTICLE THRESHOLDS & DARK(500) C --->DARK COUNTS PER DIODE INTEGER FDIODE(10000) C --->FIRST DIODE OF EVENT INTEGER NADDS(500) C --->NUMBER OF ADDS C INTEGER FRAMES(10000) C --->FRAME NUMBERS OF EVENTS CHARACTER*24 TIMES(10000) C --->PACKET TIMES INTEGER FRAME C --->FRAME COUNTER INTEGER EVNUM C --->EVENT COUNTER INTEGER DET,DET1 C --->DETECTOR NUMBERS LOGICAL FIRST INTEGER I C C KEYWORD VALUES C REAL PTHRSH, C --->PARTICLE THRESHOLD & PNSIG, C --->NUM. SIG. TO COMPUTE PTHESH & DTHRSH, C --->DARK COUNT NOISE THRESH & DNSIG C --->NUM. SIG. TO COMPUTE DTHRSH INTEGER DNUM C C DATA DECLARATIONS C DATA CNAME1/'TIME','FRAME','COUNTS','DIODES','FIRST_DIODE'/ DATA CUNIT1/5*' '/ DATA CTYPE1/-24,4*TYINT/ DATA CTYPE2/-24,3*TYINT,5*TYREAL/ DATA CNAME2/'TIME','EVENTS','DIODES','PCOUNTS','DARK_RATE', * 'ANTI_COIN','BACKGROUND','RADIATION', * 'SELECTED_DIODE'/ DATA CFORM/9*' '/ DATA CUNIT2/' ',' ',' ','COUNTS','COUNT RATE','COUNTS', * 3*'COUNT RATE'/ C --->DIODE NUMBER C----------------------------------------------------------------------------- C INITIALIZATION C FRAME=0 C --->FRAME NUMBER DO 1 I=1,500 1 DMASK(I)=1.0 FIRST=.TRUE. C C -------------------------------------- GET INPUT PARAMETERS ---------------- CALL UCLGST('input',INPUT,ISTATS(1)) CALL UCLGST('eetrailer',EETEMP,ISTATS(11)) CALL UCLGST('mask',MASKT,ISTATS(2)) CALL UCLGST('table1',TABLE1,ISTATS(3)) CALL UCLGST('table2',TABLE2,ISTATS(4)) CALL UCLGST('dark',DNAME,ISTATS(5)) CALL UCLGSR('pthresh',PTHRSH,ISTATS(6)) CALL UCLGSR('pnsig',PNSIG,ISTATS(7)) CALL UCLGSR('dthresh',DTHRSH,ISTATS(8)) CALL UCLGSR('dnsig',DNSIG,ISTATS(9)) CALL UCLGSI('dnum',DNUM,ISTATS(10)) DO 10 I=1,11 IF(ISTATS(I).NE.0)THEN CONTXT='ERROR reading CL parameter' GO TO 999 ENDIF 10 CONTINUE C C C--------------------------------------- PASS 1 ON DATA (COMPUTE PARTICLE C C OPEN TEMPLATES C CALL UIMOTP(INPUT,IDTEMP,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input filename template '//INPUT GO TO 999 ENDIF CALL UIMOTP(EETEMP,IDTMP3,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening EETRAILER template '//EETEMP GO TO 999 ENDIF IF(MASKT.NE.' ')THEN CALL UIMOTP(MASKT,IDTMP2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask file template '//MASKT GO TO 999 ENDIF ENDIF C C GET NEXT FILE NAME C 20 CALL UIMXTP(IDTEMP,NAME,ISTAT) IF(ISTAT.LT.0)GO TO 100 IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//INPUT GO TO 999 ENDIF C C GET EE TRAILER FILE NAME C CALL UIMXTP(IDTMP3,EENAME,ISTAT) IF(ISTAT.LT.0)THEN CONTXT='Insufficient eetrailer files supplied' GO TO 999 ENDIF IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//EETEMP GO TO 999 ENDIF C C GET NEXT MASK FILE NAME C IF(MASKT.NE.' ')THEN CALL UIMXTP(IDTMP2,MNAME,ISTAT) IF(ISTAT.LT.0)THEN CONTXT='Insufficient Mask files supplied' GO TO 999 ENDIF IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//MASKT GO TO 999 ENDIF ENDIF C C OPEN INPUT FILES C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input file '//NAME GO TO 999 ENDIF CALL UIMOPN(EENAME,RDONLY,IDIN3,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input file '//EENAME GO TO 999 ENDIF IF(MASKT.NE.' ')THEN CALL UIMOPN(MNAME,RDONLY,IDIN2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask file '//MNAME GO TO 999 ENDIF ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.500))THEN CONTXT='Input data must be 500 point vectors' GO TO 999 ENDIF NS=DIMEN(1) C C CHECK CONSISTENCY WITH PREVIOUS DATA C CALL UHDGSI(IDIN,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading detector value from '//NAME GO TO 999 ENDIF IF(FIRST)DET1=DET IF(DET1.NE.DET)THEN CONTXT='ALL OBSERVATIONS MUST BE SAME DETECTOR' GO TO 999 ENDIF C C READ EE TRAILER FILE INFO C CALL UIMGID(IDIN3,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading EE TRAILER file '//EENAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.24))THEN CONTXT='EE trailer data must be 24 point vectors' GO TO 999 ENDIF C C READ MASK FILE INFO C IF(MASKT.NE.' ')THEN CALL UIMGID(IDIN2,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask file '//MNAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN WRITE(CONTXT,99)MNAME,NAME 99 FORMAT('Mask vector ',A130, 1 //' must match input file- ', A130) GO TO 999 ENDIF ENDIF C C READ DATA C CALL UIGL1R(IDIN,DATA,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF CALL UIGL1R(IDIN3,ET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//EENAME GO TO 999 ENDIF IF(MASKT.NE.' ')THEN CALL UIGL1R(IDIN2,DMASK,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//MNAME GO TO 999 ENDIF ENDIF C C CLOSE IMAGES C CALL UIMCLO(IDIN,ISTAT) CALL UIMCLO(IDIN3,ISTAT) IF(MASKT.NE.' ')CALL UIMCLO(IDIN2,ISTAT) C C ALL SET TO DO SOMETHING USEFUL C ---> ACCUMULATE DATA SUMS TO COMPUTE AVERAGES C CALL ZPD1(DATA,ET,DMASK, & DNUM,FRAME,SUM,SUMSQ,NADDS, & BRATE,ARATE,RRATE,EXPO,ONED,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR ACCUMMULATING SUMS' GO TO 999 ENDIF C C GO GET NEXT IMAGE C GO TO 20 100 CONTINUE C C DONE READING INPUT DATA ------------------------------------------------ C C CLOSE TEMPLATES C CALL UIMCTP(IDTEMP,ISTAT) IF(MASKT.NE.' ') CALL UIMCTP(IDTMP2,ISTAT) CALL UIMCTP(IDTMP3,ISTAT) C C END FIRST PASS ON OBSERVATIONS LOOP ON OBSERVATIONS C C COMPUTE PARTICLE THRESHOLDS FOR EACH DIODE C IF(FRAME.EQ.0)THEN CONTXT='NO input data supplied' GO TO 999 ENDIF CALL ZPTH(SUM,SUMSQ,NADDS,PTHRSH,PNSIG,PTA,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING PARTICLE THRESHOLD' GO TO 999 ENDIF C C---------------------------------------------- PASS 2 ON DATA C TO FIND PARTICLE EVENTS C AND COMPUTE DARK COUNT C C NO NEED TO PERFORM ALL CHECKS ON INPUT DATA SETS, THEY WERE ALREADY CHECKED C FRAME=0 C C OPEN TEMPLATES C CALL UIMOTP(INPUT,IDTEMP,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input filename template '//INPUT GO TO 999 ENDIF IF(MASKT.NE.' ')THEN CALL UIMOTP(MASKT,IDTMP2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask file template '//MASKT GO TO 999 ENDIF ENDIF C C GET NEXT FILE NAME C 120 CALL UIMXTP(IDTEMP,NAME,ISTAT) IF(ISTAT.LT.0)GO TO 200 IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//INPUT GO TO 999 ENDIF C C GET NEXT MASK FILE NAME C IF(MASKT.NE.' ')THEN CALL UIMXTP(IDTMP2,MNAME,ISTAT) IF(ISTAT.LT.0)THEN CONTXT='Insufficient Mask files supplied' GO TO 999 ENDIF IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//MASKT GO TO 999 ENDIF ENDIF C C OPEN INPUT FILES C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input file '//NAME GO TO 999 ENDIF IF(MASKT.NE.' ')THEN CALL UIMOPN(MNAME,RDONLY,IDIN2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening mask file '//MNAME GO TO 999 ENDIF ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C READ MASK FILE INFO C IF(MASKT.NE.' ')THEN CALL UIMGID(IDIN2,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading mask file '//MNAME GO TO 999 ENDIF ENDIF C C READ DATA C CALL UIGL1R(IDIN,DATA,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF IF(MASKT.NE.' ')THEN CALL UIGL1R(IDIN2,DMASK,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//MNAME GO TO 999 ENDIF ENDIF C C READ FRAME TIME C CALL UHDGST(IDIN,'PKTTIME',TIMES(FRAME+1),ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR reading PKTTIME from input file '// * NAME GO TO 999 ENDIF C C CLOSE IMAGES C CALL UIMCLO(IDIN,ISTAT) IF(MASKT.NE.' ')CALL UIMCLO(IDIN2,ISTAT) CALL ZPD2(DATA,DMASK,FRAMES, & EXPO,PTA,FRAME,EVNUM,SUM,NADDS,EVENTS, & DIODES,PRATE,DRATE,DPERE,CPERE,FDIODE, & STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR IN PARTICLE DETECTION ROUTINE' GO TO 999 ENDIF C C GO GET NEXT IMAGE C GO TO 120 200 CONTINUE C C COMPUTE AVERAGE DARK COUNT AND FIND BAD DIODES C CALL ZDARK(SUM,NADDS,DARK,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING DARK COUNT' GO TO 999 ENDIF C C PRINT SUMMARY C CALL ZPDSUM(FRAME,DARK,EVNUM,DNUM,DTHRSH,DNSIG,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR PRINTING SUMMARY' GO TO 999 ENDIF C C ------------------------------------------------- OUTPUT RESULTS C C WRITE FRAME SUMMARY TABLE C C C OPEN OUTPUT TABLE C CALL UTTINN(TABLE2,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBWTYP,TBTYPC,ISTATS(2)) CALL UTPPTI(IDOUT,TBALLR,FRAME,ISTATS(3)) CALL UTPPTI(IDOUT,TBMXCL,9,ISTATS(4)) CALL UTCDEF(IDOUT,CNAME2,CUNIT2,CFORM,CTYPE2,9,COLIDS,ISTATS(5)) CALL UTTCRE(IDOUT,ISTATS(6)) DO 260 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//TABLE2 GO TO 999 ENDIF 260 CONTINUE C C COPY RESULTS TO TABLE C CALL UTCPTT(IDOUT,COLIDS(1),1,FRAME,TIMES,ISTATS(1)) CALL UTCPTR(IDOUT,COLIDS(2),1,FRAME,EVENTS,ISTATS(2)) CALL UTCPTR(IDOUT,COLIDS(3),1,FRAME,DIODES,ISTATS(3)) CALL UTCPTR(IDOUT,COLIDS(4),1,FRAME,PRATE,ISTATS(4)) CALL UTCPTR(IDOUT,COLIDS(5),1,FRAME,DRATE,ISTATS(5)) CALL UTCPTR(IDOUT,COLIDS(6),1,FRAME,ARATE,ISTATS(6)) CALL UTCPTR(IDOUT,COLIDS(7),1,FRAME,BRATE,ISTATS(7)) CALL UTCPTR(IDOUT,COLIDS(8),1,FRAME,RRATE,ISTATS(8)) IF(DNUM.GT.0) * CALL UTCPTR(IDOUT,COLIDS(9),1,FRAME,ONED,ISTATS(9)) DO 240 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table '//TABLE2 GO TO 999 ENDIF 240 CONTINUE C C ADD DETECTOR TO HEADER C CALL UTHADI(IDOUT,'DETECTOR',DET,ISTATS(1)) CALL UTHADI(IDOUT,'DNUM',DNUM,ISTATS(2)) IF((ISTATS(1).NE.0).OR.(ISTATS(2).NE.0))THEN CONTXT='ERROR WRITING HEADER TO OUTPUT TABLE'//TABLE2 GO TO 999 ENDIF CALL UTTCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output table '//TABLE2 GO TO 999 ENDIF C C EVENT SUMMARY TABLE----------------------------------------------------------- C IF(EVNUM.GT.0)THEN C C GET TIMES FOR EACH FRAME C DO 300 I=1,EVNUM 300 TIMES(I)=TIMES(FRAMES(I)) C C OPEN OUTPUT TABLE C CALL UTTINN(TABLE1,IDOUT,ISTATS(1)) CALL UTPPTI(IDOUT,TBWTYP,TBTYPC,ISTATS(2)) CALL UTPPTI(IDOUT,TBALLR,EVNUM,ISTATS(3)) CALL UTPPTI(IDOUT,TBMXCL,5,ISTATS(4)) CALL UTCDEF(IDOUT,CNAME1,CUNIT1,CFORM,CTYPE1,5,COLIDS,ISTATS(5)) CALL UTTCRE(IDOUT,ISTATS(6)) DO 360 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//TABLE1 GO TO 999 ENDIF 360 CONTINUE C C COPY RESULTS TO TABLE C CALL UTCPTT(IDOUT,COLIDS(1),1,EVNUM,TIMES,ISTATS(1)) CALL UTCPTI(IDOUT,COLIDS(2),1,EVNUM,FRAMES,ISTATS(2)) CALL UTCPTR(IDOUT,COLIDS(3),1,EVNUM,CPERE,ISTATS(3)) CALL UTCPTR(IDOUT,COLIDS(4),1,EVNUM,DPERE,ISTATS(4)) CALL UTCPTI(IDOUT,COLIDS(5),1,EVNUM,FDIODE,ISTATS(5)) DO 380 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error writing to output table '//TABLE1 GO TO 999 ENDIF 380 CONTINUE C C ADD DETECTOR TO HEADER C CALL UTHADI(IDOUT,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR WRITING HEADER TO OUTPUT TABLE'//TABLE1 GO TO 999 ENDIF CALL UTTCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output table '//TABLE1 GO TO 999 ENDIF ENDIF C C WRITE DARK RATE FILE ----------------------------------------------------- C CALL UIMCRE(DNAME,TYREAL,1,NS,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR OPENING OUTPUT DARK RATE FILE' GO TO 999 ENDIF CALL UIPL1R(IDOUT,DARK,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error writing to dark count file '//DNAME GO TO 999 ENDIF C C ADD HEADER INFO C CALL UHDASI(IDOUT,'DETECTOR',DET,' ',GENHDR,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR WRITING TO HEADER OF '//DNAME GO TO 999 ENDIF 500 CONTINUE CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR CLOSING OUTPUT DATA SET '//DNAME GO TO 999 ENDIF C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 CALL UIMCTP(IDTEMP,ISTAT) c CALL UIMCTP(IDTMP3,ISTAT) IF(MASKT.NE.' ') CALL UIMCTP(IDTMP2,ISTAT) RETURN END