SUBROUTINE YPDRK C C Module Number: 14.5 C C Module Name: YPDRK C C Keyphrase: C ---------- C FOS 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 (PTHRESH) above the average count rate for the diode. C If PTHRESH 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: YPDRK.for C C C Keywords of Accessed Files : C -------------------------- C input input input dark count observations 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 C Modules Called: C --------------- C CDBS: C ypd1, ypd2, ypth, ydark, ypdsum 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 9/20/86 D. Lindler Designed and coded C 2 Jan 88 D. LIndler New sdas i/o and standards C 3 AUG 88 D. Lindler Added FIRST_DIODE column to C output event table C 3.1 May 94 H. Bushouse Added YBASE,YSPACE to YXPTRN 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 HEADER I/O STATUS MESSAGE C C HEADER PARAMETER NOT FOUND INTEGER USHPNF PARAMETER (USHPNF = 40) C C END IRAF77.INC C C ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTAT,ISTATS(10) C --->STATUS INDICATOR CHARACTER*130 CONTXT C --->STATUS MESSAGE C C INPUT FILE I/O C CHARACTER*130 INPUT,NAME,MASKT,MNAME INTEGER IDTEMP,IDTMP2,IDIN,IDIN2,NAXIS,DTYPE,DIMEN(7),NS REAL DMASK(5000),DATA(5000) C C OUTPUT TABLE1 (EVENT TABLE) C CHARACTER*64 TABLE1 INTEGER IDOUT,COLIDS(6),CTYPE1(5) CHARACTER*20 CNAME1(5),CUNIT1(5) C C OUTPUT TABLE2 (FRAME SUMMARY) C CHARACTER*64 TABLE2 INTEGER CTYPE2(6) CHARACTER*20 CNAME2(6),CUNIT2(6),CFORM(6) C C OUTPUT DARK FILE C CHARACTER*64 DNAME C C WORK AREAS C REAL SUM(5000), C --->SUM OF DATA & SUMSQ(5000), 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 & ETIME, C --->EXPOSURE FOR CURRENT OBS. & DIODES(10000), C --->NUMBER OF DIODES/FRAME & DRATE(10000), C --->DARK RATE PER FRAME & PRATE(10000), C --->PART. COUNTS PER FRAME & ONED(10000), C --->SINGLE DIODE DARK RATE/FRAME & PTA(5000), C --->PARTICLE THRESHOLDS & DARK(5000) C --->DARK COUNTS PER DATA POINT INTEGER NADDS(5000) C --->NUMBER OF ADDS INTEGER FDIODE(10000) C --->FIRST DIODE AFFECTED BY EVENT C INTEGER FRAMES(10000) C --->FRAME NUMBERS FOR EVENTS CHARACTER*24 TIMES(10000) C --->TIME FOR EACH FRAME INTEGER FRAME C --->FRAME COUNTER INTEGER EVNUM C --->EVENT COUNTER CHARACTER*5 DET1,DET 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 --->DIODE NUMBER (0-511) C C FOS OBSERVATION DESCRIPTION C INTEGER XSTEPS,XSTEP1, C --->X STEPS & FSTCHN,NUMCHN,FSTCH1,NUMCH1, C --->FIRST AND NUMBER OF CHANNELS & OVRSCN,OVER1 INTEGER YBASE, YSPACE 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,2*TYREAL/ DATA CNAME2/'TIME','EVENTS','DIODES','PCOUNTS','DARK_RATE', * 'SELECTED_DIODE'/ DATA CFORM/6*' '/ DATA CUNIT2/' ',' ',' ','COUNTS',2*'COUNT RATE'/ C --->OVERSCAN VALUE C----------------------------------------------------------------------------- C INITIALIZATION C FRAME=0 C --->FRAME NUMBER DO 1 I=1,5000 1 DMASK(I)=1.0 FIRST=.TRUE. C C -------------------------------------- GET INPUT PARAMETERS ---------------- CALL UCLGST('input',INPUT,ISTATS(1)) 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,10 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 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 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 CHECK FOR VALID DATA C IF ((NAXIS .NE. 1) .AND. $ ((NAXIS .NE. 2) .OR. (DIMEN(2) .NE. 1))) THEN CONTXT='Input data must be a vector' GO TO 999 ENDIF NS=DIMEN(1) C C CHECK CONSISTENCY WITH PREVIOUS DATA C CALL UHDGST(IDIN,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading detector value from '//NAME GO TO 999 ENDIF CALL YXPTRN(IDIN,FSTCHN,NUMCHN,XSTEPS,OVRSCN,YBASE,YSPACE, * ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR GETTING X-PATTERN INFORMATION FROM '// * NAME GO TO 999 ENDIF IF(FIRST)THEN DET1=DET XSTEP1=XSTEPS OVER1=OVRSCN FSTCH1=FSTCHN NUMCH1=NUMCHN FIRST=.FALSE. ENDIF IF((DET1.NE.DET).OR.(XSTEP1.NE.XSTEPS).OR.(OVER1.NE.OVRSCN) * .OR.(FSTCH1.NE.FSTCHN).OR.(NUMCH1.NE.NUMCHN)) * THEN CONTXT='ALL OBSERVATIONS MUST BE SAME '// * 'DETECTOR, XSTEPS, OVRSCN, FSTCHAN, AND NUMCHAN' GO TO 999 ENDIF C C GET EXPOSURE TIME C CALL UHDGSR(IDIN,'EXPTIME',ETIME,ISTAT) IF (ISTAT .EQ. USHPNF) THEN CALL UHDGSR(IDIN, 'EXPOSURE', ETIME, ISTAT) ELSE IF (ISTAT .NE. 0) THEN CONTXT='ERROR getting exposure time from '//NAME GO TO 999 ENDIF IF (ETIME .LE. 0.) CALL YPDEXP(IDIN, NAME, ETIME, ISTAT) IF (ISTAT .NE. 0) THEN CONTXT='ERROR calculating exposure time for '//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 C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.NS))THEN CONTXT='Mask vector '//MNAME// * ' must match input file- '//NAME 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 CLOSE IMAGES C CALL UIMCLO(IDIN,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 YPD1(DATA,NS,DMASK,XSTEPS, & DNUM,ETIME,FRAME,SUM,SUMSQ,NADDS, & 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) 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 YPTH(SUM,NS,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,'FPKTTIME',TIMES(FRAME+1),ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR reading FPKTTIME 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 YPD2(DATA,DMASK,NS,XSTEPS,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 YDARK(SUM,NS,NADDS,DARK,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING DARK COUNT' GO TO 999 ENDIF C C PRINT SUMMARY C CALL YPDSUM(FRAME,NS,DARK,XSTEPS,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,6,ISTATS(4)) CALL UTCDEF(IDOUT,CNAME2,CUNIT2,CFORM,CTYPE2,6,COLIDS,ISTATS(5)) CALL UTTCRE(IDOUT,ISTATS(6)) DO 260 I=1,6 IF(ISTATS(I).NE.0)THEN CONTXT='Error creating output table '//TABLE1 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)) IF(DNUM.GE.0) * CALL UTCPTR(IDOUT,COLIDS(6),1,FRAME,ONED,ISTATS(6)) 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 UTHADT(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 UTHADT(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 UHDAST(IDOUT,'INSTRUME','FOS ',' ',GENHDR,ISTATS(1)) CALL UHDAST(IDOUT,'FILETYPE','BACKGROUND ',' ', * GENHDR,ISTATS(2)) CALL UHDAST(IDOUT,'DETECTOR',DET,' ',GENHDR,ISTATS(3)) CALL UHDASI(IDOUT,'FCHNL',FSTCHN,' ',GENHDR,ISTATS(4)) CALL UHDASI(IDOUT,'NCHNLS',NUMCHN,' ',GENHDR,ISTATS(5)) CALL UHDASI(IDOUT,'NXSTEPS',XSTEPS,' ',GENHDR,ISTATS(6)) CALL UHDASI(IDOUT,'OVERSCAN',OVRSCN,' ',GENHDR,ISTATS(7)) DO 500 I=1,7 IF(ISTATS(I).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) IF(MASKT.NE.' ') CALL UIMCTP(IDTMP2,ISTAT) RETURN END