SUBROUTINE VFLXGT ( * * outputs * : T1, T2, DX, DY, DXERR, DYERR, EPOCH, NPTS, : X0, Y0, C1, C2, APERT, ORDER, WFLAG, : T1NAME, T2NAME, X0NAME, Y0NAME, OFILE, STATUS) * * Module number: * * Module name: flex * * Keyphrase: * ---------- * Input parameters and data needed for VFLEX * * Description: * ------------ * * FORTRAN name: VFLXGT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * CL parameters: * * 'intable' I name of the table containing input data * 'outtable' I name of the table containing result * 'order' I maximum order of the fitting polynomial * 'weight' I weighting flag * 'dxname' I column name of the X deflection offset * 'dyname' I column name of the Y deflection offset * 'dxerrname' I column name of X deflection offset's * standard deviation * 'dyerrname' I column name of Y deflection offset's * standard deviation * 'T1name' I column name of temperasture T1 * 'T2name' I column name of temperasture T2 * 'x0name' I column name of nominal X deflection * 'y0name' I column name of nominal Y deflection * * input table column names: * * (dxname) I dx array as passed from 'DXNAME' * (dxerrname) I dx array's standard deviation as * passed from 'DXERRNAME' * (dyname) I dy array as passed from 'DYNAME' * (dyerrname) I dy array's standard deviation as * passed from 'DYERRNAME' * (T1name) I T1 array as passed from 'T1NAME' * (T2name) I T2 array as passed from 'T2NAME' * (x0name) I nominal X deflection as pased from 'X0NAME' * (y0name) I nominal Y deflection as pased from 'Y0NAME' * 'EPOCH' I epoch * 'APERTOBJ' I object aperture * * Subroutines Called: * ------------------- * CDBS: * CDTIN * SDAS: * UCLGSR, UCLGST, UCLGSI, UTRGTR, UTRGTD, UTRGTI, UTRGTT, UTTCLO, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 10-01-88 J.-C. HSU design and coding * *------------------------------------------------------------------------------- * *== output: * --Y deflection offset and its standard * --deviation REAL DY(1), DYERR(1), * --X deflection offset and its standard * --deviation : DX(1), DXERR(1), * --temperatures : T1(1), T2(1), * --temperature parameters : C1, C2, * --weighting scheme : WFLAG, * --nominal X and Y deflection values : X0, Y0 * --epoch DOUBLE PRECISION EPOCH(1) * --output file name CHARACTER*(*) OFILE, * --aperture name : APERT, * --name of T1 and T2 : T1NAME, T2NAME, * --name of X0 and Y0 : X0NAME, Y0NAME * --total number of valid input data points INTEGER NPTS, * --order of fittinf polynomial : ORDER, * --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, * --status : STAT(20), STATOK * --data buffer REAL COLBUF(20) * --null flag in UTRGTR LOGICAL NULMSK(30) CHARACTER*5 CHAR5 * --aperture name CHARACTER*10 APER * --column names CHARACTER*16 COLNAM(20) * --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=========================================== *------------------------------------------------------------------------------ * * input parameters: * CALL UCLGST ('intable', IFILE, STAT(1)) CALL UCLGST ('outtable', OFILE, STAT(2)) CALL UCLGSR ('c1', C1, STAT(3)) CALL UCLGSR ('c2', C2, STAT(4)) CALL UCLGST ('T1name', COLNAM(1), STAT(5)) CALL UCLGST ('T2name', COLNAM(2), STAT(6)) CALL UCLGSI ('order', ORDER, STAT(7)) CALL UCLGSR ('weight', WFLAG, STAT(8)) CALL UCLGST ('dxname', COLNAM(3), STAT(9)) CALL UCLGST ('dyname', COLNAM(4), STAT(10)) CALL UCLGST ('dxerrname', COLNAM(5), STAT(11)) CALL UCLGST ('dyerrname', COLNAM(6), STAT(12)) CALL UCLGST ('x0name', COLNAM(7), STAT(13)) CALL UCLGST ('y0name', COLNAM(8), STAT(14)) * T1NAME = COLNAM(1) T2NAME = COLNAM(2) X0NAME = COLNAM(7) Y0NAME = COLNAM(8) NC = 8 * DO 10 I = 1, 14 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'can not get CL parameter(s)' GO TO 999 END IF 10 CONTINUE * * define other column names * COLNAM(NC+1) = 'EPOCH' COLNAM(NC+2) = 'APERTOBJ' NCOLS = NC + 2 * * set up input table * 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 40 I = 1, NPOINT * * read data from input table * CALL UTRGTR (TP, COLIDN, NC, I, COLBUF, NULMSK, : STAT(1)) CALL UTRGTD (TP, COLIDN(NC+1), 1, I, EPOCH(I), : NULMSK(NC+1), STAT(2)) CALL UTRGTT (TP, COLIDN(NC+2), 1, I, APER, : NULMSK(NC+2), STAT(3)) * STATOK = ABS(STAT(1) - OK) + ABS(STAT(2) - OK) + : ABS(STAT(3) - OK) + OK DO 20 J = 1, NCOLS IF (NULMSK(J)) THEN STATOK = ERRNUM(2) GO TO 30 END IF 20 CONTINUE * * if error in UTRGTR, put an error message and do NOT increment the data array * index * 30 CONTINUE WRITE(CHAR5, '(I5)') I * IF (STATOK .NE. OK) THEN CONTXT = 'can not read input table row #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE IF (NPTS .EQ. 0) THEN X0 = COLBUF(7) Y0 = COLBUF(8) APERT = APER END IF * * check that all data were obtained at the same aperture * IF (APER .NE. APERT) THEN CONTXT = 'different aperture was used at row #' : // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) * * check that all data used the same nominal deflections * ELSE IF (COLBUF(7) .NE. X0 .OR. COLBUF(8) .NE. Y0) THEN CONTXT = 'different nominal deflection(s) was ' // : 'used at row #' // CHAR5 CALL UMSPUT (CONTXT, DEST, PRIO, STATOK) ELSE NPTS = NPTS + 1 T1(NPTS) = COLBUF(1) T2(NPTS) = COLBUF(2) DX(NPTS) = COLBUF(3) DY(NPTS) = COLBUF(4) DXERR(NPTS) = COLBUF(5) DYERR(NPTS) = COLBUF(6) EPOCH(NPTS) = EPOCH(I) END IF END IF 40 CONTINUE * * 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 ('VFLXGT: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END