SUBROUTINE VAP1GT ( * * outputs * : H0, V0, HPT, VPT, HSTPT, VSTPT, INTPT, : NTOP, NFLOOR, XMIN, XMAX, YMIN, YMAX, : LEVEL, BORDER, SCHEME, ITER, TOLERN, : IFILE, IMASK, CFILE, OFILE, STATUS) * * Module number: 15.11.2.1.1 * * Module name: apercen * * Keyphrase: * ---------- * Input CL parameters and UDL header keywords needed for the task apercen * * Description: * ------------ * * FORTRAN name: VAP1GT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * 'infile' I input file name * 'inmask' I input mask file * 'udlfile' I input UDL file * 'contourkeep' I flag of keeping contour coordinates * 'contourtable' I contour table name * 'outtable' I output table name * 'edge_level' I ratio between count levels of the edge * and the maximum * 'xweight' I weighting scheme of X axis * 'yweight' I weighting scheme of Y axis * 'itermax' I maximum number of iterations * 'tolern' I tolerance of sigma-squared difference * during least square iterations * 'frac' I specified fraction applied to the * coefficients modification * * keywords from the UDL file header: * * 'VHORIZ' I X deflection of the starting point * 'VVERT' I Y deflection of the starting point * 'VHPOINTS' I number of area scan columns * 'VVPOINTS' I number of area scanrows * 'VHORSTPT' I horizontal steps per point * 'VVERSTPT' I vertical steps per point * 'VNOINTPT' I number of integrations per point * * Subroutines Called: * ------------------- * CDBS: * None * SDAS: * UCLGST, UCLGSR, UCLGSI, UCLGSB, UIMOPN, UHDGSR, UUSLEN, UIMCLO * Others: * None * * History: * -------- * Version Date Author Description * 1 01-20-87 J.-C. HSU design and coding * 2 10-20-87 J.-C. HSU F77 SDAS * 3 08-23-90 J.-C. HSU read VHORIZ,...etc. from UDL *------------------------------------------------------------------------------- * *== output: * --x and y deflection of the starting point INTEGER H0, V0, * --number of columns and rows of the * --area scan : HPT, VPT, * --horizontal and vertical steps per * --point of the are scan : HSTPT, VSTPT, * --number of integration per point : INTPT, * --maximum number of iterations of least * --square fitting : ITER, : LEN, * --number of points used in determining * --ceiling and floor levels : NTOP, NFLOOR, * --boundary of selected section : XMIN, XMAX, YMIN, YMAX, * --error status : STATUS * --weighting schemes REAL SCHEME(*), * --tolerance of sigma-squared difference : TOLERN, * --ratio between count levels of the edge * --and the maximum : LEVEL * --flag of saving circle contour in a table LOGICAL BORDER * --input file and mask names, contour * --coordinate table and output table names CHARACTER*(*) IFILE, IMASK, CFILE, OFILE * *== local: * --loop indices and UDL file pointer INTEGER I, UDLID, * --status : STAT(20), STATOK CHARACTER*128 UDL * --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=========================================== *------------------------------------------------------------------------------ * * get parameters from parameter file * CALL UCLGST ('infile', IFILE, STAT(1)) CALL UCLGST ('inmask', IMASK, STAT(2)) CALL UCLGST ('udlfile', UDL, STAT(3)) CALL UCLGST ('outtable', OFILE, STAT(4)) CALL UCLGSB ('contourkeep', BORDER, STAT(5)) CALL UCLGST ('contourtable', CFILE, STAT(6)) CALL UCLGSI ('np_ceiling', NTOP, STAT(7)) CALL UCLGSI ('np_floor', NFLOOR, STAT(8)) CALL UCLGSR ('edge_level', LEVEL, STAT(9)) CALL UCLGSI ('xmin', XMIN, STAT(10)) CALL UCLGSI ('xmax', XMAX, STAT(11)) CALL UCLGSI ('ymin', YMIN, STAT(12)) CALL UCLGSI ('ymax', YMAX, STAT(13)) CALL UCLGSI ('itermax', ITER, STAT(14)) CALL UCLGSR ('tolern', TOLERN, STAT(15)) CALL UCLGSR ('xweight', SCHEME(1), STAT(16)) CALL UCLGSR ('yweight', SCHEME(2), STAT(17)) * DO 10 I = 1, 17 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'cannot get CL parameter(s)' GO TO 999 END IF 10 CONTINUE * * if the input value of UDL is null or blank, use the input file's root name * IF (UDL .EQ. ' ') THEN CALL UUSLEN (IFILE, LEN) UDL = IFILE(1:LEN-3) // 'ulh' END IF * * if the input value of mask is null or blank, use the input file's root name * IF (IMASK .EQ. ' ') THEN CALL UUSLEN (IFILE, LEN) IMASK = IFILE(1:LEN-3) // 'q' // IFILE(LEN-1:LEN) END IF * * open the UDL file * CALL UIMOPN (UDL, RDONLY, UDLID, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot open the UDL file' GO TO 999 END IF * * get area scan keywords from the UDL file header * CALL UHDGSI (UDLID, 'VHORIZ', H0, STAT(1)) CALL UHDGSI (UDLID, 'VVERT', V0, STAT(2)) CALL UHDGSI (UDLID, 'VHPOINTS', HPT, STAT(3)) CALL UHDGSI (UDLID, 'VVPOINTS', VPT, STAT(4)) CALL UHDGSI (UDLID, 'VHORSTPT', HSTPT, STAT(5)) CALL UHDGSI (UDLID, 'VVERSTPT', VSTPT, STAT(6)) CALL UHDGSI (UDLID, 'VNOINTPT', INTPT, STAT(7)) * DO 20 I = 1, 7 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(2) CONTXT = 'cannot get header keywords from UDL file ' GO TO 999 END IF 20 CONTINUE * * close input file * CALL UIMCLO (UDLID, STATUS) IF (STATUS .NE. OK) THEN CONTXT = 'cannot close the UDL file' GO TO 999 END IF * STATUS = OK GO TO 1000 * * write error message * 999 MESS = 'VAP1GT: ' // CONTXT CALL UMSPUT (MESS, DEST, PRIO, STATOK) * 1000 RETURN END