SUBROUTINE VAP1PT ( * * inputs * : OFILE, ROOT, APERT, : COEFF, MATRIX, CHISQ, NCOEFF, NVAR, DIM, : EDGE, TOP, FLOOR, NPTS, : XMIN, XMAX, YMIN, YMAX, : SCHEME, TOLERN, ITER, * * outputs * : STATUS) * * Module Number: 15.11.2.1.2 * * Module Name: apercen * * Keyphrase: * ---------- * Write the result of VAPER1 to an output table * * Description: * ------------ * * FORTRAN name: VAP1PT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * output table column names: * * 'ROOTNAME' O Root name of the observation * 'APERTURE' O aperture name * 'H' O horizontal coordinate of the circle * center * 'V' O vertical coordinate of the circle center * 'RADIUS' O radius of the circle * 'SIGMA_H' O standard error of H * 'SIGMA_V' O standard error of V * 'SIGMA_R' O standard error of RADIUS * 'C_H_V' O correlation between H and V * 'C_H_R' O correlation between H and RADIUS * 'C_V_R' O correlation between V and RADIUS * 'EDGE' O edge count level * 'CEILING' O ceiling count level * 'FLOOR' O floor count level * 'H_WEIGHT' O weight scheme of H axis * 'V_WEIGHT' O weight scheme of V axis * 'CHISQ' O chi-squared * 'TOLERANCE' O convergence of sigma squared * 'HMIN' O leftmost pixel of the selected section * 'HMAX' O rightmost pixel of the selected section * 'VMIN' O bottom pixel of the selected section * 'VMAX' O uppermost pixel of the selected section * 'NPOINTS' O number of data points * 'ITERMAX' O number of iterations of least square fit * * Subroutines Called: * ------------------- * CDBS: * CDTOUT * SDAS: * UTRPTR, UTRPTI, UTRPTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 02-20-87 J.-C. HSU design and coding * 2 10-30-87 J.-C. HSU F77 SDAS * 3 08-23-90 J.-C. HSU Add aperture name and root name * 4 08-23-90 J.-C. HSU Add ceiling, floor, edge level *------------------------------------------------------------------------------- * *== input: * --output table name CHARACTER*(*) OFILE, * --root name : ROOT, * --aperture name : APERT * --number of coefficients and variables INTEGER NCOEFF, NVAR, * --number of input data points : NPTS, * --boundary of the selected section : XMIN, XMAX, YMIN, YMAX, * --number of least square iterations : ITER, * --dimension of the covariance matrix as * --declared in the calling routine : DIM * --fitting coefficients, covariance * --matrix, and chi-squared DOUBLE PRECISION COEFF(1), MATRIX(DIM, DIM), CHISQ * --weighting schemes REAL SCHEME(1), * --ceiling, floor, and edge levels : TOP, FLOOR, EDGE, * --tolerance of sigma-squared difference : TOLERN * *== output: * --error status INTEGER STATUS * *== local: * --output table content REAL CBUFF(50) * --loop index INTEGER I, J, K, * --pointer to table descripter : TP, * --number of existed rows of output table : NROWS, * --number of columns : NCOLS, * --column data type : DTYPE(50), * --column identifiers : COLIDN(50), : IBUFF(50), * --error status : STAT(20), STATOK * --output table column names CHARACTER*16 CNAME(50), * --column units : UNIT(50) * --column format CHARACTER*8 COLFMT(50) * --error message context CHARACTER*130 CONTXT, MESS *==========================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) 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/ * --message destination and priority DATA DEST, PRIO /1, 0/ *=========================end hsp.inc=========================================== *------------------------------------------------------------------------------ * * specify output buffer contents * * coefficients and their standard errors * DO 10 I = 1, NCOEFF CBUFF(I) = REAL(COEFF(I)) CBUFF(NCOEFF+I) = REAL(SQRT(MATRIX(I,I))) 10 CONTINUE * * correlations between coefficients * K = 2 * NCOEFF IF (NCOEFF .NE. 1) THEN DO 30 I = 1, NCOEFF-1 DO 20 J = I+1, NCOEFF K = K + 1 CBUFF(K) = REAL(MATRIX(I, J) / : SQRT(MATRIX(I, I) * MATRIX(J, J))) 20 CONTINUE 30 CONTINUE END IF * * others * DO 40 I = 1, NVAR CBUFF(K+I) = SCHEME(I) 40 CONTINUE CBUFF(K+NVAR+1) = EDGE CBUFF(K+NVAR+2) = TOP CBUFF(K+NVAR+3) = FLOOR CBUFF(K+NVAR+4) = REAL(CHISQ) CBUFF(K+NVAR+5) = TOLERN * IBUFF(1) = XMIN IBUFF(2) = XMAX IBUFF(3) = YMIN IBUFF(4) = YMAX IBUFF(5) = NPTS IBUFF(6) = ITER * * specify column names * CNAME(1) = 'ROOTNAME' CNAME(2) = 'APERTURE' * * coefficients * CNAME(3) = 'H' CNAME(4) = 'V' CNAME(5) = 'RADIUS' * * standard error of coefficients * CNAME(2+NCOEFF+1) = 'SIGMA_H' CNAME(2+NCOEFF+2) = 'SIGMA_V' CNAME(2+NCOEFF+3) = 'SIGMA_R' * * correlation between coefficients * CNAME(2+NCOEFF*2+1) = 'C_H_V' CNAME(2+NCOEFF*2+2) = 'C_H_R' CNAME(2+NCOEFF*2+3) = 'C_V_R' * * others * K = 2+NCOEFF*2+3 CNAME(K+1) = 'H_WEIGHT' CNAME(K+2) = 'V_WEIGHT' CNAME(K+NVAR+1) = 'EDGE' CNAME(K+NVAR+2) = 'CEILING' CNAME(K+NVAR+3) = 'FLOOR' CNAME(K+NVAR+4) = 'CHISQ' CNAME(K+NVAR+5) = 'TOLERANCE' * CNAME(K+NVAR+6) = 'HMIN' CNAME(K+NVAR+7) = 'HMAX' CNAME(K+NVAR+8) = 'VMIN' CNAME(K+NVAR+9) = 'VMAX' CNAME(K+NVAR+10) = 'NPOINTS' CNAME(K+NVAR+11) = 'ITERMAX' * * define column units, formats, and data types * NCOLS = K + 11 + NVAR * DO 50 I = 1, NCOLS UNIT(I) = ' ' COLFMT(I) = ' ' 50 CONTINUE DTYPE(1) = -10 DTYPE(2) = -10 DO 60 I = 3, NCOLS-2 DTYPE(I) = TYREAL 60 CONTINUE DTYPE(NCOLS-1) = TYINT DTYPE(NCOLS) = TYINT * COLFMT(3) = 'F8.2' COLFMT(4) = 'F8.2' COLFMT(5) = 'F8.2' COLFMT(2+NCOEFF+1) = 'F6.2' COLFMT(2+NCOEFF+2) = 'F6.2' COLFMT(2+NCOEFF+3) = 'F6.2' COLFMT(2+NCOEFF*2+1) = 'F6.3' COLFMT(2+NCOEFF*2+2) = 'F6.3' COLFMT(2+NCOEFF*2+3) = 'F6.3' COLFMT(K+1) = 'G5.1' COLFMT(K+2) = 'G5.1' COLFMT(K+NVAR+1) = 'F9.1' COLFMT(K+NVAR+2) = 'F9.1' COLFMT(K+NVAR+3) = 'F9.1' COLFMT(K+NVAR+4) = 'G8.2' COLFMT(K+NVAR+5) = 'G7.1' COLFMT(K+NVAR+6) = 'I3' COLFMT(K+NVAR+7) = 'I3' COLFMT(K+NVAR+8) = 'I3' COLFMT(K+NVAR+9) = 'I3' COLFMT(K+NVAR+10) = 'I4' * * set up output table * CALL CDTOUT (OFILE, CNAME, UNIT, COLFMT, DTYPE, NCOLS, : TP, COLIDN, NROWS, STATUS) IF (STATUS .NE. 0) THEN CONTXT = 'cannot set up output table' GO TO 999 END IF * * write result to output table * CALL UTRPTT (TP, COLIDN(1), 1, NROWS+1, ROOT, STAT(1)) CALL UTRPTT (TP, COLIDN(2), 1, NROWS+1, APERT, STAT(2)) CALL UTRPTR (TP, COLIDN(3), NCOLS-6, NROWS+1, CBUFF, STAT(3)) CALL UTRPTI (TP, COLIDN(NCOLS-5), 6, NROWS+1, IBUFF, STAT(4)) * DO 70 I = 1, 4 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(2) CONTXT = 'cannot write a row to the output table' GO TO 999 END IF 70 CONTINUE * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close the output table' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VAP1PT: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END