SUBROUTINE VAP2GT ( * * inputs * : IMGDSC, MSKDSC, * * outputs * : H0, V0, HPT, VPT, HSTPT, VSTPT, INTPT, V2, V3, : DATA, MASK, EPOCH, : DETOBJ, MODE, FORMAT, ROOT, NPTS, STATUS) * * Module number: 15.11.2.2.1 * * Module name: imgscale * * Keyphrase: * ---------- * Input data needed for aperture location calibration phase II. * * Description: * ------------ * * FORTRAN name: VAP2GT.FOR * * Keywords of accessed files and tables: * -------------------------------------- * Name I/O Description / Comments * * parameters from the input file header: * * 'ROOTNAME' I root name of the observation set * 'MODE' I observation mode * 'DATA_FMT' I data format * 'DETECTOB' I detector of the object * 'EPOCH' I epoch of the observation * * '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 * * 'V2' I V2 coordinate * 'V3' I V3 coordinate * * Subroutines Called: * ------------------- * CDBS: * None * SDAS: * UIMOPN, UIMGID, UDMGET, UIGL1R, UIGL2R, UMSPUT * Others: * None * * History: * -------- * Version Date Author Description * 1 01-20-87 J.-C. HSU design and coding * 2 11-10-87 J.-C. HSU F77 SDAS *------------------------------------------------------------------------------- * *== inputs: * --image/mask descripters INTEGER IMGDSC, MSKDSC * *== 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, * --total number of data points : NPTS, * --number of integration per point : INTPT, * --detector ID of object : DETOBJ * --V2 and V3 coordinates REAL V2, V3, * --data and mask array : DATA(1), MASK(1) * --instrument mode (SCP or SSP) CHARACTER*(*) MODE, * --HSP data format (byte, ..., all) : FORMAT, * --observation ID : ROOT * --epoch of the observation DOUBLE PRECISION EPOCH * --error status INTEGER STATUS * *== local: * --loop indices INTEGER I, J, K, * --file pointer : INFID, INMID, * --data type in input file : DTYPE, * --data file dimension : NAXIS, * --dimension in each axis : DIMEN(7), * --status : STAT(20), STATOK * --input file and mask names CHARACTER*128 IFILE, IMASK * --error message context CHARACTER*130 CONTXT *==========================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) INTEGER EOF PARAMETER (EOF = -2) * * 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) * --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=========================================== *------------------------------------------------------------------------------ * * expand image name template * CALL UIMXTP (IMGDSC, IFILE, STAT(1)) CALL UIMXTP (MSKDSC, IMASK, STAT(2)) * * check on end of file * IF (STAT(1) .EQ. EOF .OR. STAT(2) .EQ. EOF) GO TO 100 * IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN STATUS = ERRNUM(1) CONTXT = 'cannot expand file name template' GO TO 999 END IF * * open input file, input mask, and get file information of the input file * CALL UIMOPN (IFILE, RDONLY, INFID, STAT(1)) CALL UIMOPN (IMASK, RDONLY, INMID, STAT(2)) CALL UIMGID (INFID, DTYPE, NAXIS, DIMEN, STAT(3)) * DO 10 J = 1, 3 IF (STAT(J) .NE. OK) THEN STATUS = ERRNUM(2) CONTXT = 'cannot get input file/mask file name or open ' : // 'them' GO TO 999 END IF 10 CONTINUE * * determine the number of data points * IF (NAXIS .EQ. 1) THEN NPTS = DIMEN(1) ELSE IF (NAXIS .EQ. 2) THEN NPTS = DIMEN(1) * DIMEN(2) ELSE STATUS = ERRNUM(2) CONTXT = 'illegal dimension (>2)' GO TO 999 END IF * * get configuration parameters and epoch from the input file header * CALL UHDGST (INFID, 'ROOTNAME', ROOT, STAT(1)) CALL UHDGST (INFID, 'MODE', MODE, STAT(2)) CALL UHDGST (INFID, 'DATA_FMT', FORMAT, STAT(3)) CALL UHDGSI (INFID, 'DETECTOB', DETOBJ, STAT(4)) CALL UHDGSD (INFID, 'EPOCH', EPOCH, STAT(5)) * * get area scan parameters from input file header * CALL UHDGSI (INFID, 'VHORIZ', H0, STAT(6)) CALL UHDGSI (INFID, 'VVERT', V0, STAT(7)) CALL UHDGSI (INFID, 'VHPOINTS', HPT, STAT(8)) CALL UHDGSI (INFID, 'VVPOINTS', VPT, STAT(9)) CALL UHDGSI (INFID, 'VHORSTPT', HSTPT, STAT(10)) CALL UHDGSI (INFID, 'VVERSTPT', VSTPT, STAT(11)) CALL UHDGSI (INFID, 'VNOINTPT', INTPT, STAT(12)) * * get pointing parameters from input file header * CALL UHDGSR (INFID, 'V2', V2, STAT(13)) CALL UHDGSR (INFID, 'V3', V3, STAT(14)) * DO 20 I = 1, 14 IF (STAT(I) .NE. OK) THEN STATUS = ERRNUM(3) CONTXT = 'error getting parameter(s) from input file ' : // 'header' GO TO 999 END IF 20 CONTINUE * * read input data and mask to local arrays * DO 30 K = 1, NPTS/DIMEN(1) IF (NAXIS .EQ. 1 .OR. DIMEN(2) .EQ. 1) THEN CALL UIGL1R (INFID, DATA(1), STAT(1)) CALL UIGL1R (INMID, MASK(1), STAT(2)) ELSE J = (K - 1) * DIMEN(1) CALL UIGL2R (INFID, K, DATA(1+J), STAT(1)) CALL UIGL2R (INMID, K, MASK(1+J), STAT(2)) END IF * IF (STAT(1) .NE. OK .OR. STAT(2) .NE. OK) THEN STATUS = ERRNUM(4) CONTXT = 'error reading data from input file/mask' GO TO 999 END IF 30 CONTINUE * * close input file/mask * CALL UIMCLO (INFID, STAT(1)) CALL UIMCLO (INMID, STAT(2)) * DO 40 I = 1, 2 IF (STAT(I) .NE. OK) THEN CONTXT = 'cannot close input file/mask ' GO TO 999 END IF 40 CONTINUE * STATUS = OK GO TO 1000 * * close image list * 100 CALL UIMCTP (IMGDSC, STATOK) CALL UIMCTP (MSKDSC, STATOK) * STATUS = OK GO TO 1000 * * write error message * 999 CALL UMSPUT ('VAP2GT: ' // CONTXT, DEST, PRIO, STATOK) * 1000 RETURN END