SUBROUTINE VFCPT ( * * inputs * : OFILE, FOCUSF, FOCUSC, APER, TARGET, : LOWEND, HIEND, REJECT, TMEAN, EPMEAN, : NPTS, NREJ, * * outputs * : STATUS) * * Module Number: 15.2.1.3 * * Module Name: focusv * * Keyphrase: * ---------- * Write the result of VFOCUS to output table * * Description: * ------------ * * FORTRAN name: VFCPT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * output table column names: * * 'FOCUS_FLAT' O best focus setting from flat top scheme * 'FOCUS_CENT' O best focus setting from centroid scheme * 'APER_NAME' O aperture name * 'TRGTNAME' O target name * 'FOCUS_LO' O lower limit of observed focus settings * 'FOCUS_HI' O upper limit of observed focus settings * 'REJECT_LEVEL' O level of rejection * 'TEMP_MEAN' O mean temperature of all observations * 'EPOCH_MEAN' O mean epoch of all observations * 'NPOINTS' O number of data points * 'NREJECTS' O number of excluded points * * Subroutines Called: * ------------------- * CDBS: * CDTOUT * SDAS: * UTRPTR, UTRPTI, UTRPTD, UTRPTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 05-26-87 J.-C. HSU design and coding * 2 11-20-87 J.-C. HSU F77 SDAS *------------------------------------------------------------------------------- * *== input: * --file name of the output table CHARACTER*(*) OFILE, * --aperture name and target name : APER, TARGET * --optimum focus settings REAL FOCUSF, FOCUSC, * --lower and upper limits of observed * --focus settings : LOWEND, HIEND, * --rejection level : REJECT, * --mean temperature : TMEAN * --mean epoch DOUBLE PRECISION EPMEAN * --number of input data points INTEGER NPTS, * --number of excluded points : NREJ * *== output: * --error status INTEGER STATUS * *== local: * --loop index INTEGER I, * --number of existed rows of output table : NROWS, * --number of columns in output table : NCOLS, * --pointer to table descripter : TP, * --column identifiers : COLIDN(20), * --data type : DTYPE(20), * --error status : STAT(20), STATOK * --output table names CHARACTER*16 CNAME(20), * --column units : UNIT(20) * --column format CHARACTER*8 COLFMT(20) * --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 output table column names * CNAME(1) = 'FOCUS_FLAT' CNAME(2) = 'FOCUS_CENT' CNAME(3) = 'APER_NAME' CNAME(4) = 'TRGTNAME' CNAME(5) = 'FOCUS_LO' CNAME(6) = 'FOCUS_HI' CNAME(7) = 'REJECT_LEVEL' CNAME(8) = 'TEMP_MEAN' CNAME(9) = 'EPOCH_MEAN' CNAME(10) = 'NPOINTS' CNAME(11) = 'NREJECTS' * * column data type * DTYPE(1) = TYREAL DTYPE(2) = TYREAL DTYPE(3) = -10 DTYPE(4) = -20 DTYPE(5) = TYREAL DTYPE(6) = TYREAL DTYPE(7) = TYREAL DTYPE(8) = TYREAL DTYPE(9) = TYDOUB DTYPE(10) = TYINT DTYPE(11) = TYINT * NCOLS = 11 * DO 10 I = 1, NCOLS UNIT(I) = ' ' COLFMT(I) = ' ' 10 CONTINUE * * set up output table * CALL CDTOUT (OFILE, CNAME, UNIT, COLFMT, DTYPE, NCOLS, : TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot set up output table' GO TO 999 END IF * * put the result into output table * CALL UTRPTR (TP, COLIDN(1), 1, NROWS+1, FOCUSF, STAT(1)) CALL UTRPTR (TP, COLIDN(2), 1, NROWS+1, FOCUSC, STAT(2)) CALL UTRPTT (TP, COLIDN(3), 1, NROWS+1, APER, STAT(3)) CALL UTRPTT (TP, COLIDN(4), 1, NROWS+1, TARGET, STAT(4)) CALL UTRPTR (TP, COLIDN(5), 1, NROWS+1, LOWEND, STAT(5)) CALL UTRPTR (TP, COLIDN(6), 1, NROWS+1, HIEND, STAT(6)) CALL UTRPTR (TP, COLIDN(7), 1, NROWS+1, REJECT, STAT(7)) CALL UTRPTR (TP, COLIDN(8), 1, NROWS+1, TMEAN, STAT(8)) CALL UTRPTD (TP, COLIDN(9), 1, NROWS+1, EPMEAN, STAT(9)) CALL UTRPTI (TP, COLIDN(10), 1, NROWS+1, NPTS, STAT(10)) CALL UTRPTI (TP, COLIDN(11), 1, NROWS+1, NREJ, STAT(11)) * DO 20 I = 1, NCOLS IF (STAT(I) .NE. 0) THEN STATUS = ERRNUM(1) CONTXT = 'cannot write to output table' GO TO 999 END IF 20 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 ('VFCPT: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END