SUBROUTINE VPHAPT ( * * inputs * : OFILE, SCHEME, OPTIM, NPTS, WTFLAG, COEFF, CHISQ, : ITER, TOLERN, FRAC, HIVOLT, DETID, TARGET, : TMPMIN, TMPMAX, TMPAVE, EPMIN, EPMAX, EPAVE, * * outputs * : STATUS) * * Module Number: 15.3.1.4 * * Module Name: phav * * Keyphrase: * ---------- * Write the result of VPHA to output table * * Description: * ------------ * * FORTRAN name: VPHAPT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * output table column names: * * 'SCHEME' O scheme of determining the optimum * 'TRGTNAME' O target name * 'BEST_THRESH' O optimum discriminator setting * 'GAUSS_AMPL' O height of the gaussian component * 'GAUSS_CENTER' O discriminator setting of the gaussian's * center * 'GAUSS_WIDTH' O half "width" of the gaussian component * 'EXP_AMPL' O height of the exponential component * 'EXP_WIDTH' O "width" of the exponential component * at which the exp falls to 1/e * 'BACKGROUND' O constant term in the INTEGRATED PHD * 'CHISQ' O chi squared of the fit * 'WEIGHT' O digital count rate weighting scheme * 'VOLTAGE' O high voltage setting * 'TOLERANCE' O tolerance of sigma-squared difference * during least square iterations * 'FRACTION' O specified fraction applied to the * coefficients modification * 'TEMPMIN' O lower limit of temperature * 'TEMPMAX' O upper limit of temperature * 'TEMPAVE' O average temperature * 'EPOCHMIN' O lower limit of epoch * 'EPOCHMAX' O upper limit of epoch * 'EPOCHAVE' O average epoch * 'DETECTOR' O detector ID * 'NPOINTS' O number of data points * 'ITERMAX' O maximum number of least square iterations * * Subroutines Called: * ------------------- * CDBS: * CDTOUT * SDAS: * UTRPTR, UTRPTI, UTRPTD, UTRPTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 11-15-85 J.-C. HSU design and coding * 2 09-20-87 J.-C. HSU F77 standard * *------------------------------------------------------------------------------- * *== input: * --VMS file name of 'OUTTABLE' CHARACTER*(*) OFILE, * --target name : TARGET, * --scheme of determining optimum * --threshold setting : SCHEME * --weighting scheme REAL WTFLAG(*), * --optimum threshold setting : OPTIM, * --minimum, maximum, and average temperature : TMPMIN, TMPMAX, TMPAVE, * --tolerance of sigma-squared differnce * --during least square iterations : TOLERN, * --specified fraction applied to * --coefficients modification : FRAC, * --high volatge, discriminator threshold * --setting : HIVOLT * --minimum, maximum and mean epoch DOUBLE PRECISION EPMIN, EPMAX, EPAVE, * --result of the least square fitting : COEFF(*), * --chi-squared : CHISQ * --number of input data points INTEGER NPTS, * --number of iteration in least square : ITER, * --detector ID : DETID * *== output: * --error status INTEGER STATUS * *== local: * --loop index INTEGER I, * --number of existed rows of output * --SDAS table : NROWS, * --number of columns : NCOLS, * --pointer to table descripter : TP, * --column identifiers : COLIDN(40), * --data type : DTYPE(40), * --data buffer : CBUFF3(10), * --error status : STAT(20), STATOK * --data buffer REAL CBUFF(40) DOUBLE PRECISION CBUFF2(20) * --column format CHARACTER*8 COLFMT(40) * --output SDAS table names CHARACTER*16 CNAME(40), * --column units : UNIT(40) * --error message context CHARACTER*130 CONTXT *==========================begin iraf77.inc (without INTEGER*2)================= * Include file for the iraf77 FORTRAN interface to the IRAF VOS * Get IRAF common into main program * LOGICAL MEMB(1) INTEGER MEMI(1) INTEGER MEML(1) REAL MEMR(1) DOUBLE PRECISION MEMD(1) COMPLEX MEMX(1) EQUIVALENCE (MEMB, MEMI, MEML, MEMR, MEMD, MEMX) COMMON /MEM/ MEMD * * File I/O access modes * INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER RDWRIT PARAMETER (RDWRIT = 2) INTEGER WRONLY PARAMETER (WRONLY = 3) INTEGER APPEND PARAMETER (APPEND = 4) INTEGER NEWFIL PARAMETER (NEWFIL = 5) INTEGER TMPFIL PARAMETER (TMPFIL = 6) INTEGER NEWCPY PARAMETER (NEWCPY = 7) INTEGER NEWIMG PARAMETER (NEWIMG = 5) * * codes for data types * INTEGER TYBOOL PARAMETER (TYBOOL = 1) INTEGER TYCHAR PARAMETER (TYCHAR = 2) INTEGER TYSHOR PARAMETER (TYSHOR = 3) INTEGER TYINT PARAMETER (TYINT = 4) INTEGER TYLONG PARAMETER (TYLONG = 5) INTEGER TYREAL PARAMETER (TYREAL = 6) INTEGER TYDOUB PARAMETER (TYDOUB = 7) INTEGER TYCPLX PARAMETER (TYCPLX = 8) INTEGER TYUSHT PARAMETER (TYUSHT = 11) INTEGER TYUBYT PARAMETER (TYUBYT = 12) * * TYTEXT is a special code for the iraf77 interface; it is not in the VOS * INTEGER TYTEXT PARAMETER (TYTEXT = 13) *========================end iraf77.inc========================================= *=========================begin hsp.inc========================================= * --status return code INTEGER OK, ERRNUM(20) * --message destination and priority INTEGER DEST, PRIO DATA OK /0/ DATA ERRNUM /701, 702, 703, 704, 705, 706, 707, 708, 709, 710, : 711, 712, 713, 714, 715, 716, 717, 718, 719, 720/ DATA DEST, PRIO /1, 0/ *=========================end hsp.inc=========================================== *------------------------------------------------------------------------------ * * specify column names * CNAME(1) = 'SCHEME' CNAME(2) = 'TRGTNAME' * CNAME(3) = 'DETECTOR' CNAME(4) = 'NPOINTS' CNAME(5) = 'ITERMAX' CNAME(6) = 'BEST_THRESH' CNAME(7) = 'GAUSS_AMPL' CNAME(8) = 'GAUSS_CENTER' CNAME(9) = 'GAUSS_WIDTH' CNAME(10) = 'EXP_AMPL' CNAME(11) = 'EXP_WIDTH' CNAME(12) = 'BACKGROUND' CNAME(13) = 'CHISQ' CNAME(14) = 'WEIGHT' CNAME(15) = 'VOLTAGE' CNAME(16) = 'TOLERANCE' CNAME(17) = 'FRACTION' CNAME(18) = 'TEMPMIN' CNAME(19) = 'TEMPMAX' CNAME(20) = 'TEMPAVE' * CNAME(21) = 'EPOCHMIN' CNAME(22) = 'EPOCHMAX' CNAME(23) = 'EPOCHAVE' * NCOLS = 23 * * column data types * DTYPE(1) = -16 DTYPE(2) = -20 * DO 10 I = 3, 5 DTYPE(I) = TYINT 10 CONTINUE * DO 20 I = 6, 20 DTYPE(I) = TYREAL 20 CONTINUE * DO 30 I = 21, 23 DTYPE(I) = TYDOUB 30 CONTINUE * * column units and display formats * DO 40 I = 1, NCOLS UNIT(I) = ' ' COLFMT(I) = ' ' 40 CONTINUE * * specify buffer contents * CBUFF3(1) = DETID CBUFF3(2) = NPTS CBUFF3(3) = ITER * CBUFF(1) = OPTIM CBUFF(2) = REAL(COEFF(1)) CBUFF(3) = REAL(COEFF(2)) CBUFF(4) = REAL(COEFF(3)) CBUFF(5) = REAL(COEFF(4)) CBUFF(6) = REAL(COEFF(5)) CBUFF(7) = REAL(COEFF(6)) CBUFF(8) = REAL(CHISQ) CBUFF(9) = WTFLAG(2) CBUFF(10) = HIVOLT CBUFF(11) = TOLERN CBUFF(12) = FRAC CBUFF(13) = TMPMIN CBUFF(14) = TMPMAX CBUFF(15) = TMPAVE * CBUFF2(1) = EPMIN CBUFF2(2) = EPMAX CBUFF2(3) = EPAVE * * find out the number of rows the SDAS table already has and append * the result of this routine as one new row at the bottom * * set up output table * CALL CDTOUT (OFILE, CNAME, UNIT, COLFMT, DTYPE, NCOLS, : TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'error setting up output table' GO TO 999 END IF * * write results to the output table * CALL UTRPTT (TP, COLIDN(1), 1, NROWS+1, SCHEME, STAT(1)) CALL UTRPTT (TP, COLIDN(2), 1, NROWS+1, TARGET, STAT(2)) CALL UTRPTI (TP, COLIDN(3), 3, NROWS+1, CBUFF3, STAT(3)) CALL UTRPTR (TP, COLIDN(6), 15, NROWS+1, CBUFF, STAT(4)) CALL UTRPTD (TP, COLIDN(21), 3, NROWS+1, CBUFF2, STAT(5)) * DO 50 I = 1, 5 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'cannot write a row to output table' GO TO 999 END IF 50 CONTINUE * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close output table' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 CALL UMSPUT ('VPHAPT: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END