include include include include include # TESTIMX -- create FOC test image with all RSDP type headers # # D. Giaretta, 01-Aug-1987 Original SPP version # Phil Hodge 29-Nov-1989 Update for current ICD-19. # Phil Hodge 24-May-1990 nrows, ncols = indef before calling xgfcoord # Phil Hodge 4-Sep-1991 Modify for new headers. procedure t_testimx() char outfile[SZ_FNAME] # output file name char datatype[SZ_LINE] # datatype int linebeg, sampbeg # start coord of image int naxis1 # naxis1 for image int naxis2 # naxis2 for image real start # start value real xinc, yinc # line/sample increments int xblock, yblock # block sizes for bool reso # are we adding reseau char coordfile[SZ_FNAME] # file with coords for reseau char modelfile[SZ_FNAME] # file with reseau model char templnam[SZ_FNAME] # file template pointer sp pointer rm pointer out pointer template pointer immap(), imgs2r(), impl2r(), imps2r() pointer temg, temp, xy real linesum int i, j, xs, xe, ys, ye, m1, m2, maxis1, maxis2, nrows, ncols real clgetr() int clgeti(), clgwrd(), kwindex, dtype bool streq() errchk clgeti, clgetr, clgetb begin call smark (sp) # get file name call clgstr( "outfile", outfile, SZ_FNAME) call nowhite( outfile, outfile, SZ_FNAME) if (outfile[1] == EOS) call error( 0, "outfile must not be blank") # select and code data type for output image kwindex = clgwrd( "datatype", datatype, SZ_LINE, ",real,int,long,short,double,ushort,ubyte") call strlwr(datatype) if ( streq(datatype, "real") ) dtype = TY_REAL else if ( streq(datatype, "int") ) dtype = TY_INT else if ( streq(datatype, "long") ) dtype = TY_LONG else if ( streq(datatype, "short") ) dtype = TY_SHORT else if ( streq(datatype, "double") ) dtype = TY_DOUBLE else if ( streq(datatype, "ushort") ) dtype = TY_USHORT else if ( streq(datatype, "ubyte") ) dtype = TY_UBYTE else call error (0, "illegal data type") sampbeg = clgeti("sampbeg") linebeg = clgeti("linebeg") naxis1 = clgeti("naxis1") naxis2 = clgeti("naxis2") start = clgetr("start") xinc = clgetr("xinc") yinc = clgetr("yinc") xblock = clgeti("xblock") if ( IS_INDEFI (xblock) || xblock <= 0 ) xblock = naxis1 yblock = clgeti("yblock") if ( IS_INDEFI (yblock) || yblock <= 0 ) yblock = naxis2 call clgstr("coordfile", coordfile, SZ_FNAME) call nowhite( coordfile, coordfile, SZ_FNAME) if (coordfile[1] != EOS ) { call clgstr("modelfile", modelfile, SZ_FNAME) reso = true } # get template info call clgstr("template", templnam, SZ_FNAME) template = immap( templnam, READ_ONLY, 0) out = immap( outfile, NEW_COPY, template) IM_NDIM(out) = 2 IM_PIXTYPE(out) = dtype IM_LEN(out, 1) = naxis1 IM_LEN(out, 2) = naxis2 for (i=1; i<=naxis2; i=i+1) { temp = impl2r( out, i) linesum = start + xinc*int((i-1)/xblock) for (j=1; j<=naxis1; j=j+1) Memr[temp + j-1] = linesum + yinc*int((j-1)/yblock) } if (reso) { nrows = INDEFI ncols = INDEFI call xgfcoord( coordfile, INDEFI, INDEFI, nrows, ncols, xy) call salloc( rm, (MAX_MODELS + 1)*SZ_MODEL_INFO, TY_REAL) call xgfmodel( modelfile, rm, MAX_MODELS ) maxis1 = MODEL_NAXIS1(rm, 1) maxis2 = MODEL_NAXIS2(rm, 1) call imunmap(out) out = immap( outfile, READ_WRITE, 0) # set advice call imseti( out, IM_ADVICE, RANDOM) for (i=1; i<=nrows*ncols; i=i+1) { xs = Memr[xy+2*i-2] - maxis1/2 xe = xs + maxis1 - 1 ys = Memr[xy+2*i-1] - maxis2/2 ye = ys + maxis2 - 1 # check if within boundary if ( xs >= 1 && xe <= naxis1 && ys >= 1 && ye <= naxis2 ) { temg = imgs2r( out, xs, xe, ys, ye ) temp = imps2r( out, xs, xe, ys, ye ) do m2 = 1, maxis2 do m1 = 1, maxis1 Memr[temp -1 + (m2-1)*maxis1 + m1] = Memr[MODEL_PTR(rm, 1) -1 +(m2-1)*maxis1 + m1]* Memr[temg -1 + (m2-1)*maxis1 + m1]/100.0 } } } # label image call xgenlab( out ) call imunmap(template) call imunmap(out) call sfree (sp) end # XGENLAB -- label output image procedure xgenlab( outim) pointer outim # i: input image #-- double clgetd(), dval int clgeti(), i, relay real clgetr(), r bool clgetb(), b char s[SZ_LINE], cammode[SZ_FNAME], filter[SZ_FNAME] bool streq() begin call clgstr( "rootname", s, SZ_LINE) call impstr( outim, "rootname", s) call clgstr( "optcrly", s, SZ_LINE) call impstr( outim, "optcrly", s) call clgstr( "cammode", cammode, SZ_FNAME) call impstr( outim, "cammode", cammode) if (streq ("F48", s)) { relay = 48 call imputi (outim, "f_ratio", 48) } else if (streq ("F96", s)) { relay = 96 if (streq ("INBEAM", cammode)) call imputi (outim, "f_ratio", 288) else call imputi (outim, "f_ratio", 96) } else { relay = 0 call eprintf ("invalid optcrly\n") } call clgstr( "smmmode", s, SZ_LINE) call impstr( outim, "smmmode", s) call clgstr ("shtmode", s, SZ_LINE) call impstr (outim, "shtmode", s) call clgstr ("ledmode", s, SZ_LINE) call impstr (outim, "ledmode", s) call clgstr( "pxformt", s, SZ_LINE) call impstr( outim, "pxformt", s) i = clgeti( "optelt1" ) call imputi( outim, "optelt1", i) call filtnam (relay, 1, i, filter, SZ_FNAME) call impstr (outim, "filtnam1", filter) i = clgeti( "optelt2" ) call imputi( outim, "optelt2", i) call filtnam (relay, 2, i, filter, SZ_FNAME) call impstr (outim, "filtnam2", filter) i = clgeti( "optelt3" ) call imputi( outim, "optelt3", i) call filtnam (relay, 3, i, filter, SZ_FNAME) call impstr (outim, "filtnam3", filter) i = clgeti( "optelt4" ) call imputi( outim, "optelt4", i) call filtnam (relay, 4, i, filter, SZ_FNAME) call impstr (outim, "filtnam4", filter) i = clgeti( "sampbeg" ) r = i - 1. call imputr (outim, "sampoff", r) i = clgeti( "linebeg" ) r = i - 1. call imputr (outim, "lineoff", r) i = IM_LEN(outim, 1) call imputi (outim, "samppln", i) i = IM_LEN(outim, 2) call imputi (outim, "linepfm", i) i = clgeti( "dnformt" ) call imputi( outim, "dnformt", i) r = clgetr( "exptime" ) call imputr( outim, "exptime", r) call clgstr( "date", s, SZ_LINE) call impstr( outim, "date", s) dval = clgetd( "crval1" ) call imputd( outim, "crval1", dval) dval = clgetd( "crval2" ) call imputd( outim, "crval2", dval) r = clgetr( "crpix1" ) call imputr( outim, "crpix1", r) r = clgetr( "crpix2" ) call imputr( outim, "crpix2", r) r = clgetr( "cd1_1") call imputr( outim, "cd1_1", r) r = clgetr( "cd1_2") call imputr( outim, "cd1_2", r) r = clgetr( "cd2_1") call imputr( outim, "cd2_1", r) r = clgetr( "cd2_2") call imputr( outim, "cd2_2", r) b = clgetb("mir_revr") call imputb( outim, "mir_revr", b ) r = clgetr( "orientat" ) call imputr( outim, "orientat", r) i = clgeti( "fillcnt" ) call imputi( outim, "fillcnt", i ) i = clgeti( "errcnt" ) call imputi( outim, "errcnt", i ) call clgstr( "fpkttime", s, SZ_LINE) call impstr( outim, "fpkttime", s) call clgstr( "lpkttime", s, SZ_LINE) call impstr( outim, "lpkttime", s) call clgstr( "ctype1", s, SZ_LINE) call impstr( outim, "ctype1", s) call clgstr( "ctype2", s, SZ_LINE) call impstr( outim, "ctype2", s) # dummy values call imputr (outim, "i_minpixval", 0.) call imputr (outim, "i_maxpixval", -1.) IM_LIMTIME(outim) = IM_MTIME(outim) + 1 end define SZ_FILT 7 # max length of filter name define F48_RELAY 48 # f/48 relay define F96_RELAY 96 # f/96 relay define NUM_FILT48 8 # number of filters per wheel for f/48 define NUM_FILT96 12 # number of filters per wheel for f/96 define NUM_WH48 2 # number of filter wheels for f/48 define NUM_WH96 4 # number of filter wheels for f/96 # filtnam -- convert filter number to name # This routine takes a filter number and converts it to a filter name. # # Phil Hodge, 4-Sep-1991 Subroutine created procedure filtnam (relay, wheel, optelt, filtname, maxch) int relay # i: relay number (48 or 96) int wheel # i: number of filter wheel in use int optelt # i: filter number in filter wheel char filtname[ARB] # o: filter name int maxch # i: max char in filter name #-- char filt48 [SZ_FILT, NUM_FILT48, NUM_WH48] # f/48 filter names char filt96 [SZ_FILT, NUM_FILT96, NUM_WH96] # f/96 filter names bool init # true if initialization has been done data init /false/ begin # Fill in values for filter names (unless already done) if ( ! init ) { call strcpy ("CLEAR1", filt48[1,1,1], SZ_FILT) call strcpy ("PRISM3", filt48[1,2,1], SZ_FILT) call strcpy ("F150W", filt48[1,3,1], SZ_FILT) call strcpy ("F195W", filt48[1,4,1], SZ_FILT) call strcpy ("F140W", filt48[1,5,1], SZ_FILT) call strcpy ("F175W", filt48[1,6,1], SZ_FILT) call strcpy ("F305LP", filt48[1,7,1], SZ_FILT) call strcpy ("F220W", filt48[1,8,1], SZ_FILT) call strcpy ("CLEAR2", filt48[1,1,2], SZ_FILT) call strcpy ("PRISM2", filt48[1,2,2], SZ_FILT) call strcpy ("F342W", filt48[1,3,2], SZ_FILT) call strcpy ("F430W", filt48[1,4,2], SZ_FILT) call strcpy ("F180LP", filt48[1,5,2], SZ_FILT) call strcpy ("F275W", filt48[1,6,2], SZ_FILT) call strcpy ("F130LP", filt48[1,7,2], SZ_FILT) call strcpy ("PRISM1", filt48[1,8,2], SZ_FILT) call strcpy ("CLEAR1", filt96[1,1,1], SZ_FILT) call strcpy ("F8ND", filt96[1,2,1], SZ_FILT) call strcpy ("POL120", filt96[1,3,1], SZ_FILT) call strcpy ("F2ND", filt96[1,4,1], SZ_FILT) call strcpy ("F600M", filt96[1,5,1], SZ_FILT) call strcpy ("F630M", filt96[1,6,1], SZ_FILT) call strcpy ("POL0", filt96[1,7,1], SZ_FILT) call strcpy ("F4ND", filt96[1,8,1], SZ_FILT) call strcpy ("F6ND", filt96[1,9,1], SZ_FILT) call strcpy ("PRISM2", filt96[1,10,1], SZ_FILT) call strcpy ("POL60", filt96[1,11,1], SZ_FILT) call strcpy ("PRISM1", filt96[1,12,1], SZ_FILT) call strcpy ("CLEAR2", filt96[1,1,2], SZ_FILT) call strcpy ("F370LP", filt96[1,2,2], SZ_FILT) call strcpy ("F342W", filt96[1,3,2], SZ_FILT) call strcpy ("F430W", filt96[1,4,2], SZ_FILT) call strcpy ("F480LP", filt96[1,5,2], SZ_FILT) call strcpy ("F140W", filt96[1,6,2], SZ_FILT) call strcpy ("F175W", filt96[1,7,2], SZ_FILT) call strcpy ("F220W", filt96[1,8,2], SZ_FILT) call strcpy ("F275W", filt96[1,9,2], SZ_FILT) call strcpy ("F320W", filt96[1,10,2], SZ_FILT) call strcpy ("F486N", filt96[1,11,2], SZ_FILT) call strcpy ("F501N", filt96[1,12,2], SZ_FILT) call strcpy ("CLEAR3", filt96[1,1,3], SZ_FILT) call strcpy ("F210M", filt96[1,2,3], SZ_FILT) call strcpy ("F120M", filt96[1,3,3], SZ_FILT) call strcpy ("F152M", filt96[1,4,3], SZ_FILT) call strcpy ("F1ND", filt96[1,5,3], SZ_FILT) call strcpy ("F130M", filt96[1,6,3], SZ_FILT) call strcpy ("F190M", filt96[1,7,3], SZ_FILT) call strcpy ("F170M", filt96[1,8,3], SZ_FILT) call strcpy ("F140M", filt96[1,9,3], SZ_FILT) call strcpy ("F195W", filt96[1,10,3], SZ_FILT) call strcpy ("F165W", filt96[1,11,3], SZ_FILT) call strcpy ("F231M", filt96[1,12,3], SZ_FILT) call strcpy ("CLEAR4", filt96[1,1,4], SZ_FILT) call strcpy ("F346M", filt96[1,2,4], SZ_FILT) call strcpy ("F410M", filt96[1,3,4], SZ_FILT) call strcpy ("F470M", filt96[1,4,4], SZ_FILT) call strcpy ("F550M", filt96[1,5,4], SZ_FILT) call strcpy ("F372M", filt96[1,6,4], SZ_FILT) call strcpy ("F130LP", filt96[1,7,4], SZ_FILT) call strcpy ("F502M", filt96[1,8,4], SZ_FILT) call strcpy ("F253M", filt96[1,9,4], SZ_FILT) call strcpy ("F278M", filt96[1,10,4], SZ_FILT) call strcpy ("F307M", filt96[1,11,4], SZ_FILT) call strcpy ("F437M", filt96[1,12,4], SZ_FILT) init = true } # Copy to output. (Add one to optelt to convert from zero indexing # to one indexing.) if (relay == F48_RELAY) call strcpy (filt48 [1, optelt+1, wheel], filtname, maxch) else if (relay == F96_RELAY) call strcpy (filt96 [1, optelt+1, wheel], filtname, maxch) end