SUBROUTINE VTMPGT ( * * outputs * : X, Y, YERR, EPOCH, ORDER, WFLAG, TYPE, NPTS, : NATTRB, ATTRB, XREF, XMINKY, XMAXKY, XREFKY, : DETID, APERT, VOLT, GAIN, THRESH, : OFILE, STATUS) * * Module number: 15.1.0.1.1 * * Module name: polyfit * * Keyphrase: * ---------- * Input parameters and data needed for VTEMP * * Description: * ------------ * * FORTRAN name: VTMPGT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * CL parameters: * * 'intable' I SDAS table containing input data * 'outtable' I SDAS table containing result * 'order' I maximum order of the fitting polynomial * 'weight' I weighting flag * 'type' I data type * 'yname' I name of the quantity to be fitted (y) * 'yerrname' I name of y array's standard deviation * 'xname' I name of the x array * 'xrefname' I name of the reference x value * 'xref' I reference x value * 'xminname' I name of x array's minimum value * 'xmaxname' I name of x array's maximum value * 'nattrib' I number of attributes to be copied to the * output table * 'attribI' I attributes to be copied to the output * table (max I = 5) * * input table column names: * * (yname) I y array as passed from 'YNAME' * (yerrname) I y array's standard deviation as * passed from 'YERRNAME' * (xname) I x array as passed from 'XNAME' * 'EPOCH' I epoch * (attribi) I attributes to be copied to the output * table as passed from 'ATTRIBi' * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGSR, UCLGST, UCLGSI, UTRGTR, UTRGTD, UTRGTI, UTRGTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 10-15-85 J.-C. HSU design and coding * 2 07-15-87 J.-C. HSU F77 standard * *------------------------------------------------------------------------------- * *== output: * --Y quantity and its standard deviation REAL Y(1), YERR(1), * --X quantity : X(1), * --weighting scheme : WFLAG, * --reference X value, : XREF, * --high voltage, gain setting, and * --discriminator threshold setting : VOLT, GAIN, THRESH * --epoch DOUBLE PRECISION EPOCH(1) * --attribute names CHARACTER*(*) ATTRB(1), * --data type : TYPE, * --output file name : OFILE, * --aperture name : APERT, * --name of maximum and minimum X values : XMINKY, XMAXKY, * --name of reference X : XREFKY * --total number of valid input data points INTEGER NPTS, * --order of fittinf polynomial : ORDER, * --detector ID : DETID, * --number of attributes : NATTRB, * --error status : STATUS * *== local: * --number of data points INTEGER NPOINT, * --pointer of table descripter and column * --identifier : TP, COLIDN(20), * --loop indices, number of input columns : I, J, NCOLS, NC, * --index of first valid data : INDEX1, * --status : STAT(20), STATOK * --data buffer REAL COLBUF(20) * --column names CHARACTER*16 COLNAM(20) * --null flag in UTRGTR LOGICAL NULMSK(30) CHARACTER*1 CHAR1 CHARACTER*5 CHAR5 * --input file name CHARACTER*128 IFILE * --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=========================================== *------------------------------------------------------------------------------ * NC = 4 * * input parameters: * input and output table names, number of attributes, attributes, order of * the fitting polynomial, weighting * scheme, reference X value, data type, column names of: * (1) the y quantity, (2) standard deviation of y, (3) x quantity, * (4) reference x value, (5) minimum x value, (6) maximum x value. * CALL UCLGST ('intable', IFILE, STAT(1)) CALL UCLGST ('outtable', OFILE, STAT(2)) CALL UCLGSI ('nattrib', NATTRB, STAT(3)) CALL UCLGSI ('order', ORDER, STAT(4)) CALL UCLGSR ('weight', WFLAG, STAT(5)) CALL UCLGSR ('xref', XREF, STAT(6)) CALL UCLGST ('type', TYPE, STAT(7)) CALL UCLGST ('yname', COLNAM(1), STAT(8)) CALL UCLGST ('yerrname', COLNAM(2), STAT(9)) CALL UCLGST ('xname', COLNAM(3), STAT(10)) CALL UCLGST ('xminname', XMINKY, STAT(11)) CALL UCLGST ('xmaxname', XMAXKY, STAT(12)) CALL UCLGST ('xrefname', XREFKY, STAT(13)) DO 10 I = 1, NATTRB WRITE (CHAR1, '(I1)') I CALL UCLGST ('attrib'//CHAR1, ATTRB(I), STAT(13+I)) COLNAM(NC+I) = ATTRB(I) 10 CONTINUE * DO 20 I = 1, 13+NATTRB IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'can not get CL parameter(s)' GO TO 999 END IF 20 CONTINUE * * input the following: Y quantity and its standard deviation, X quantity, * epoch, from input SDAS table * * first of all, find out how many data points are in the input table * COLNAM(4) = 'EPOCH' NCOLS = NC + NATTRB * CALL CDTIN (IFILE, COLNAM, NCOLS, : TP, COLIDN, NPOINT, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'error setting up input table' GO TO 999 END IF * NPTS = 0 DO 50 I = 1, NPOINT CALL UTRGTR (TP, COLIDN, 3, I, : COLBUF, NULMSK, STAT(1)) CALL UTRGTD (TP, COLIDN(4), 1, I, : EPOCH(I), NULMSK(4), STAT(2)) * STATOK = ABS(STAT(1) - OK) + ABS(STAT(2) - OK) + OK DO 30 J = 1, NC IF (NULMSK(J)) THEN STATOK = ERRNUM(2) GO TO 40 END IF 30 CONTINUE * * if error in UTRGTR, put an error message and do NOT increment the data array * index * 40 CONTINUE IF (STATOK .NE. OK) THEN WRITE(CHAR5, '(I5)') I CONTXT = 'can not read input table row #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE NPTS = NPTS + 1 IF (NPTS .EQ. 1) THEN INDEX1 = I END IF Y(NPTS) = COLBUF(1) YERR(NPTS) = COLBUF(2) X(NPTS) = COLBUF(3) EPOCH(NPTS) = EPOCH(I) END IF 50 CONTINUE * * read attributes * IF (NATTRB .GT. 0) THEN DO 60 I = 1, NATTRB IF (ATTRB(I) .EQ. 'DETECTOB' .OR. ATTRB(I) .EQ. : 'DET_NUM') THEN CALL UTRGTI (TP, COLIDN(NC+I), 1, INDEX1, : DETID, NULMSK(NC+I), STAT(3+I)) ELSE IF (ATTRB(I) .EQ. 'APERTOBJ' .OR. ATTRB(I) : .EQ. 'APER_NAME') THEN CALL UTRGTT (TP, COLIDN(NC+I), 1, INDEX1, : APERT, NULMSK(NC+I), STAT(3+I)) ELSE IF (ATTRB(I) .EQ. 'VOLTAGE') THEN CALL UTRGTR (TP, COLIDN(NC+I), 1, INDEX1, : VOLT, NULMSK(NC+I), STAT(3+I)) ELSE IF (ATTRB(I) .EQ. 'VGAIND') THEN CALL UTRGTR (TP, COLIDN(NC+I), 1, INDEX1, : GAIN, NULMSK(NC+I), STAT(3+I)) ELSE IF (ATTRB(I) .EQ. 'THRESH') THEN CALL UTRGTR (TP, COLIDN(NC+I), 1, INDEX1, : THRESH, NULMSK(NC+I), STAT(3+I)) ELSE STATUS = ERRNUM(3) CONTXT = 'invalid attribute ' // ATTRB(I) GO TO 999 END IF 60 CONTINUE END IF * * close the input table * CALL UTTCLO (TP, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close input table' GO TO 999 END IF * IF (NPTS .LE. 0) THEN STATUS = ERRNUM(4) CONTXT = 'no input data been successfully read' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 CALL UMSPUT ('VTMPGT: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END