SUBROUTINE VAP3S * * Module number: 15.11.2.3.1 * * Module name: smaperloc * * Keyphrase: * ---------- * Aperture location calibration Phase III of a small aperture. * * Description: * ------------ * Maximum number of points on each side of the area scan is 50. * Maximum number of edge points is 300. * * FORTRAN name: VAP3S.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * Subroutines Called: * ------------------- * CDBS: * VAP3SG, VMAP3S, VAP3SP, CDPEAK, CDEDGE, CDEGPT, CDCIRC * SDAS: * UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 01-20-87 J.-C. HSU design and coding * 2 11-20-87 J.-C. HSU F77 SDAS * *------------------------------------------------------------------------------- * *== local: * --total number of data points of the * --input time series INTEGER NPTS, * --size of COUNT, FLAG, V2, and V3 arrays * --in each dimension : DIMMAX, * --maximum number of iterations of least * --square fitting : ITER, * --number of coefficients and variables : NCOEFF, NVAR, * --size of the covariance matrix in each * --dimension : DIM * --input arrays of count rate, its standard * --deviation, V2 and V3 coordinates REAL CT(2500), DCT(2500), V2(2500), V3(2500), * --mask value of good points : OKVAL, * --mask value of particle events : HITVAL, * --observed (average) number of counts, * --its standard error, its flag and its * --coordinates of each point of the scan : COUNT(50, 50), DCOUNT(50, 50), : FLAG(50, 50), : V2ARR(50, 50), V3ARR(50, 50), * --weighting schemes : SCHEME(2), * --specified fraction applied to the * --coefficient modification : FRAC, * --tolerance of sigma-squared difference : TOLERN, * --ration between count levels of the * --edge and the maximum : LEVEL, * --peak count level and its standard error : PEAKCT, DPEAK, * --edge count level and its standard error : EDGECT, DEDGE, * --edge coordinates and their standard errors : XEDGE(300), YEDGE(300), : DX(300), DY(300) * --epoch of observation DOUBLE PRECISION EPOCH(2500), * --fitting coefficients, covariance * --matrix, and chi-squared : COEFF(10), MATRIX(5, 5), CHISQ, * --epoch range : EPOMIN, EPOMAX * --number of points on each side of the * --grid INTEGER SIDEPT, * --error status : STATUS, STATOK, * --number of highest count points to be * --selected and number of edge points : NPEAK, NEDGE * --flag of saving circle contour in a table LOGICAL BORDER * --contour table column names CHARACTER*12 XNAME, YNAME, DXNAME, DYNAME * --contour coordinate table and output * --table names CHARACTER*128 CFILE, OFILE * --error message context CHARACTER*130 CONTXT *=========================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=========================================== *------------------------------------------------------------------------------ * * maximum dimension on each side of the grid and the size of the covariance * matrix * DIMMAX = 50 DIM = 5 * OKVAL = 1. HITVAL = 0. * * input parameters and data * CALL VAP3SG ( : V2, V3, CT, DCT, EPOCH, NPTS, LEVEL, : BORDER, SCHEME, FRAC, ITER, TOLERN, : XNAME, YNAME, DXNAME, DYNAME, : CFILE, OFILE, STATUS) * IF (STATUS .NE. OK) THEN GO TO 1000 END IF * * check array size * IF (NPTS .GT. DIMMAX**2) THEN STATUS = ERRNUM(1) CONTXT = 'oversized 2-D array' GO TO 999 END IF * * rearrange the arrays to follow the order of increasing V2, V3 * CALL VMAP3S (NPTS, DIMMAX, V2, V3, CT, DCT, EPOCH, : OKVAL, HITVAL, : COUNT, DCOUNT, FLAG, V2ARR, V3ARR, : SIDEPT, EPOMIN, EPOMAX, STATUS) * IF (STATUS .NE. OK) THEN GO TO 1000 END IF * * find the maximum count level * NPEAK = NPTS / 10 + 1 CALL CDPEAK (COUNT, FLAG, OKVAL, HITVAL, DIMMAX, NPEAK, : SIDEPT, SIDEPT, : PEAKCT, DPEAK, STATUS) * IF (STATUS .NE. OK) THEN GO TO 1000 END IF * * specify the edge level * EDGECT = PEAKCT * LEVEL DEDGE = DPEAK * LEVEL * * find the edge points * CALL CDEDGE (EDGECT, DEDGE, COUNT, DCOUNT, FLAG, V2ARR, V3ARR, : OKVAL, HITVAL, DIMMAX, SIDEPT, SIDEPT, : XEDGE, YEDGE, DX, DY, NEDGE, STATUS) * IF (STATUS .NE. OK) THEN GO TO 1000 END IF * * check array size * IF (NEDGE .GT. 300) THEN STATUS = ERRNUM(2) CONTXT = 'oversized edge array' GO TO 999 END IF * * write the edge point coordinates to a table * IF (BORDER) THEN CALL CDEGPT (XEDGE, YEDGE, DX, DY, NEDGE, CFILE, : XNAME, YNAME, DXNAME, DYNAME, STATUS) * IF (STATUS .NE. OK) THEN GO TO 1000 END IF END IF * * fit a circle to the contour points * CALL CDCIRC (XEDGE, YEDGE, DX, DY, NEDGE, SCHEME, FRAC, DIM, : ITER, TOLERN, : NCOEFF, NVAR, COEFF, MATRIX, CHISQ, STATUS) IF (STATUS .NE. OK) THEN GO TO 1000 END IF * * write results to output table * CALL VAP3SP (OFILE, COEFF, MATRIX, CHISQ, NCOEFF, NVAR, DIM, : SCHEME, TOLERN, FRAC, ITER, NEDGE, STATUS) IF (STATUS .NE. OK) THEN GO TO 1000 END IF * STATUS = OK GO TO 1000 * * write error message * 999 CALL UMSPUT ('VAP3S: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END