include include # ODCNV -- Get a line of data possibly convolved. Also get the unconvolved # data, the sky data, and the sky sigma data. # # This routine must be called sequentially starting with the first line. # It is initialized when the first line. Memory is freed by using a final # call with a line of zero. procedure convolve (in, bpm, sky, sig, exp, offset, scale, line, cnv, indata, bp, cnvdata, skydata, sigdata, expdata, cnvwt, logfd) pointer in[2] #I Image pointers pointer bpm[2] #I BPM pointer pointer sky[2] #I Sky map pointer sig[2] #I Sigma map pointer exp[2] #I Exposure map int offset[2] #I Offsets real scale[2] #I Image scales int line #I Line char cnv[ARB] #I Convolution string pointer indata[2] #O Pointers to unconvolved image data pointer bp #O Bad pixel data pointer cnvdata #O Pointer to convolved image data pointer skydata[2] #O Pointer to sky data pointer sigdata[2] #O Pointer to sigma data corrected by exposure map pointer expdata[2] #O Pointer to exposure map data real cnvwt #O Weight for convolved sigma int logfd #I Logfile int i, j, k, nx, ny, nx2, ny2, nc, nl, mode, off real wts, wts1 pointer bpm2, kptr, ptr, symptr, symwptr bool dobpm, overlap, fp_equalr() pointer kernel, sym, symbuf, symwts, buf, buf2, buf3, bpbuf, bpwts, wtsl, scales data kernel/NULL/, sym/NULL/, symbuf/NULL/, symwts/NULL/ data buf/NULL/, buf2/NULL/, buf3/NULL/, bpbuf/NULL/, bpwts/NULL/ data wtsl/NULL/, scales/NULL/ errchk cnvparse, cnvgline2 begin # If no convolution. if (cnv[1] == EOS) { if (line == 0) return call cnvgline1 (line, offset, in, bpm, indata, bp) call cnvgline2 (line, offset, in, sky, sig, exp, skydata, sigdata, expdata) cnvwt = 1 if (in[2] == NULL) cnvdata = indata[1] else call asubr_scale (Memr[indata[1]], scale[1], Memr[indata[2]], scale[2], Memr[cnvdata], IM_LEN(in[1],1)) return } # Free memory. if (line == 0) { if (symbuf != NULL) { do i = 0, ARB { ptr = Memi[symbuf+i] if (ptr == -1) break call mfree (ptr, TY_REAL) } } if (symwts != NULL) { do i = 0, ARB { ptr = Memi[symwts+i] if (ptr == -1) break call mfree (ptr, TY_REAL) } } call mfree (scales, TY_REAL) call mfree (wtsl, TY_REAL) call mfree (kernel, TY_REAL) call mfree (scales, TY_REAL) call mfree (sym, TY_INT) call mfree (symbuf, TY_POINTER) call mfree (symwts, TY_POINTER) call mfree (buf, TY_REAL) call mfree (buf2, TY_REAL) call mfree (buf3, TY_REAL) call mfree (bpbuf, TY_INT) call mfree (bpwts, TY_REAL) return } # Initialize by getting the kernel coefficients, setting the # image I/O buffers using a scrolling array, and allocate memory. if (line == 1 || buf == NULL) { if (buf != NULL) { if (symbuf != NULL) { do i = 0, ARB { ptr = Memi[symbuf+i] if (ptr == -1) break call mfree (ptr, TY_REAL) } } if (symwts != NULL) { do i = 0, ARB { ptr = Memi[symwts+i] if (ptr == -1) break call mfree (ptr, TY_REAL) } } call mfree (scales, TY_REAL) call mfree (wtsl, TY_REAL) call mfree (kernel, TY_REAL) call mfree (scales, TY_REAL) call mfree (sym, TY_INT) call mfree (symbuf, TY_POINTER) call mfree (symwts, TY_POINTER) call mfree (buf, TY_REAL) call mfree (buf2, TY_REAL) call mfree (buf3, TY_REAL) call mfree (bpbuf, TY_INT) call mfree (bpwts, TY_REAL) } nc = IM_LEN(in[1],1) nl = IM_LEN(in[1],2) call cnvparse (cnv, kernel, nx, ny, logfd) nx2 = nx / 2 ny2 = ny / 2 call malloc (scales, ny, TY_REAL) call calloc (wtsl, ny, TY_REAL) call amovkr (1., Memr[scales], ny) # Check for lines which are simple scalings of the first line. do i = 2, ny { kptr = kernel + (i - 1) * nx wts = 0. do k = 0, nx-1 { if (Memr[kptr+k] == 0. || Memr[kernel+k] == 0.) { wts = 0. break } if (wts == 0.) wts = Memr[kptr+k] / Memr[kernel+k] else { wts1 = Memr[kptr+k] / Memr[kernel+k] if (!fp_equalr (wts, wts1)) break } } if (wts != 0. && fp_equalr (wts, wts1)) { Memr[scales+i-1] = wts call amovr (Memr[kernel], Memr[kptr], nx) } } wts = 0 do i = 1, ny { kptr = kernel + (i - 1) * nx wts1 = 0. do j = 1, nx { wts1 = wts1 + Memr[kptr] kptr = kptr + 1 } Memr[wtsl+i-1] = wts1 wts = wts + wts1 } if (wts != 0.) { call adivkr (Memr[wtsl], wts, Memr[wtsl], ny) call adivkr (Memr[kernel], wts, Memr[kernel], nx*ny) } cnvwt = sqrt (wts) if (in[2] == NULL) bpm2 = NULL else bpm2 = bpm[2] if (bpm[1] == NULL && bpm2 == NULL) dobpm = false else dobpm = true if (dobpm) { call malloc (bpbuf, nc*ny, TY_INT) call malloc (bpwts, nc, TY_REAL) call calloc (symwts, ny*ny+1, TY_POINTER) Memi[symwts+ny*ny] = -1 } # Check for any line symmetries in the kernel. call malloc (sym, ny, TY_INT) call calloc (symbuf, ny*ny+1, TY_POINTER) Memi[symbuf+ny*ny] = -1 do i = ny, 1, -1 { kptr = kernel + (i - 1) * nx do j = ny, 1, -1 { ptr = kernel + (j - 1) * nx do k = 0, nx-1 { if (Memr[kptr+k] != Memr[ptr+k]) break } if (k == nx) { Memi[sym+i-1] = j break } } } do i = ny, 1, -1 { k = 0 do j = ny, 1, -1 if (Memi[sym+j-1] == i) k = k + 1 if (k == 1) Memi[sym+i-1] = 0 } call malloc (buf, nc*ny, TY_REAL) if (in[2] != NULL) { call malloc (buf2, nc*ny, TY_REAL) call malloc (buf3, nc*ny, TY_REAL) } if (in[2] != NULL) { overlap = true if (1-offset[1] < 1 || nc-offset[1] > IM_LEN(in[2],1)) overlap = false if (1-offset[2] < 1 || nl-offset[2] > IM_LEN(in[2],2)) overlap = false } do i = 1, ny { call cnvgline1 (i, offset, in, bpm, indata, bp) off = mod (i, ny) * nc call amovr (Memr[indata[1]], Memr[buf+off], nc) if (in[2] != NULL) { call amovr (Memr[indata[2]], Memr[buf2+off], nc) call asubr_scale (Memr[buf+off], scale[1], Memr[buf2+off], scale[2], Memr[buf3+off], nc) } if (dobpm) call amovi (Memi[bp], Memi[bpbuf+off], nc) } } # Get new line. j = line + ny2 if (j > ny && j <= nl) { call cnvgline1 (j, offset, in, bpm, indata, bp) off = mod (j, ny) * nc call amovr (Memr[indata[1]], Memr[buf+off], nc) if (in[2] != NULL) { call amovr (Memr[indata[2]], Memr[buf2+off], nc) call asubr_scale (Memr[buf+off], scale[1], Memr[buf2+off], scale[2], Memr[buf3+off], nc) } if (dobpm) { ptr = bpbuf + off call amovi (Memi[bp], Memi[ptr], nc) } } # Compute the convolution vector with boundary reflection. # Save and reuse lines with the same kernel weights apart # from a scale factor. kptr = kernel call aclrr (Memr[cnvdata], nc) if (dobpm) call aclrr (Memr[bpwts], nc) do i = 1, ny { j = line + i - ny2 - 1 if (j < 1) j = 2 - j else if (j > nl) j = 2 * nl - j off = mod (j, ny) * nc if (in[2] == NULL) ptr = buf else ptr = buf3 k = Memi[sym+i-1] if (k == 0) { mode = 1 symptr = ptr symwptr = bpwts } else { if (k == i) mode = 2 else mode = 3 symptr = Memi[symbuf+(k-1)*ny+mod(j,ny)] if (symptr == NULL) { call malloc (symptr, nc, TY_REAL) Memi[symbuf+(k-1)*ny+mod(j,ny)] = symptr mode = 2 } if (dobpm) { symwptr = Memi[symwts+(k-1)*ny+mod(j,ny)] if (symwptr == NULL) { call malloc (symwptr, nc, TY_REAL) Memi[symwts+(k-1)*ny+mod(j,ny)] = symwptr } } } if (dobpm) call convolve2 (Memr[ptr+off], Memr[cnvdata], Memr[symptr], nc, Memr[kptr], Memr[scales+i-1], nx, Memi[bpbuf+off], Memr[wtsl+i-1], Memr[bpwts], Memr[symwptr], mode) else call convolve1 (Memr[ptr+off], Memr[cnvdata], Memr[symptr], nc, Memr[kptr], Memr[scales+i-1], nx, mode) kptr = kptr + nx } if (dobpm) { do i = 0, nc-1 if (Memr[bpwts+i] != 0.) Memr[cnvdata+i] = Memr[cnvdata+i] / Memr[bpwts+i] } # Set the output vectors. off = mod (line, ny) * nc indata[1] = buf + off if (dobpm) { if (bpm2 == NULL) bp = bpbuf + off else call amovi (Memi[bpbuf+off], Memi[bp], nc) } if (in[2] != NULL) { if (overlap) indata[2] = buf2 + off else call amovr (Memr[buf2+off], Memr[indata[2]], nc) } call cnvgline2 (line, offset, in, sky, sig, exp, skydata, sigdata, expdata) end # ODCNV1 -- One dimensional convolution with boundary reflection. # # The convolution is added to the output so that it might be used # as part of a 2D convolution. procedure convolve1 (in, out, save, nc, xkernel, scale, nx, mode) real in[nc] #I Input data to be convolved real out[nc] #O Output convolved data real save[nc] #U Output saved data int nc #I Number of data points real xkernel[nx] #I Convolution weights real scale #I Scale for saved vector int nx #I Number of convolution points (must be odd) int mode #I Mode (1=no save, 2=save, 3=use save) int i, j, k, nx2 real val bool fp_equalr() begin if (mode == 1) { nx2 = nx / 2 do i = 1, nx2 { val = 0 do j = 1, nx { k = i + j - nx2 - 1 if (k < 1) k = 2 - k val = val + in[k] * xkernel[j] } out[i] = out[i] + val } do i = nx2+1, nc-nx2 { k = i - nx2 val = 0 do j = 1, nx { val = val + in[k] * xkernel[j] k = k + 1 } out[i] = out[i] + val } do i = nc-nx2+1, nc { val = 0 do j = 1, nx { k = i + j - nx2 - 1 if (k > nc) k = 2 * nc - k val = val + in[k] * xkernel[j] } out[i] = out[i] + val } } else if (mode == 2) { nx2 = nx / 2 do i = 1, nx2 { val = 0 do j = 1, nx { k = i + j - nx2 - 1 if (k < 1) k = 2 - k val = val + in[k] * xkernel[j] } out[i] = out[i] + val save[i] = val } do i = nx2+1, nc-nx2 { k = i - nx2 val = 0 do j = 1, nx { val = val + in[k] * xkernel[j] k = k + 1 } out[i] = out[i] + val save[i] = val } do i = nc-nx2+1, nc { val = 0 do j = 1, nx { k = i + j - nx2 - 1 if (k > nc) k = 2 * nc - k val = val + in[k] * xkernel[j] } out[i] = out[i] + val save[i] = val } } else { if (fp_equalr (1., scale)) { do i = 1, nc out[i] = out[i] + save[i] } else { do i = 1, nc out[i] = out[i] + scale * save[i] } } end # ODCNV2 -- One dimensional convolution with boundary reflection and masking. # # The convolution is added to the output so that it might be used # as part of a 2D convolution. procedure convolve2 (in, out, save, nc, xkernel, scale, nx, bp, wtssum, wts, wtsave, mode) real in[nc] #I Input data to be convolved real out[nc] #O Output convolved data real save[nc] #U Output saved data int nc #I Number of data points real xkernel[nx] #I Convolution weights real scale #I Scale for saved vector int nx #I Number of convolution points (must be odd) int bp[nc] #I Bad pixel data real wtssum #I Sum of weights real wts[nc] #I Weights real wtsave[nc] #U Output saved weight data int mode #I Mode (1=no save, 2=save, 3=use save) int i, j, k, nx2 real val, wt bool fp_equalr() begin if (mode == 1) { nx2 = nx / 2 do i = 1, nx2 { val = 0 wt = wtssum do j = 1, nx { k = i + j - nx2 - 1 if (k < 1) k = 2 - k if (bp[k] == 0) val = val + in[k] * xkernel[j] else wt = wt - xkernel[j] } out[i] = out[i] + val wts[i] = wts[i] + wt } do i = nx2+1, nc-nx2 { k = i - nx2 val = 0 wt = wtssum do j = 1, nx { if (bp[k] == 0) val = val + in[k] * xkernel[j] else wt = wt - xkernel[j] k = k + 1 } out[i] = out[i] + val wts[i] = wts[i] + wt } do i = nc-nx2+1, nc { val = 0 wt = wtssum do j = 1, nx { k = i + j - nx2 - 1 if (k > nc) k = 2 * nc - k if (bp[k] == 0) val = val + in[k] * xkernel[j] else wt = wt - xkernel[j] } out[i] = out[i] + val wts[i] = wts[i] + wt } } else if (mode == 2) { nx2 = nx / 2 do i = 1, nx2 { val = 0 wt = wtssum do j = 1, nx { k = i + j - nx2 - 1 if (k < 1) k = 2 - k if (bp[k] == 0) val = val + in[k] * xkernel[j] else wt = wt - xkernel[j] } out[i] = out[i] + val wts[i] = wts[i] + wt save[i] = val wtsave[i] = wt } do i = nx2+1, nc-nx2 { k = i - nx2 val = 0 wt = wtssum do j = 1, nx { if (bp[k] == 0) val = val + in[k] * xkernel[j] else wt = wt - xkernel[j] k = k + 1 } out[i] = out[i] + val wts[i] = wts[i] + wt save[i] = val wtsave[i] = wt } do i = nc-nx2+1, nc { val = 0 wt = wtssum do j = 1, nx { k = i + j - nx2 - 1 if (k > nc) k = 2 * nc - k if (bp[k] == 0) val = val + in[k] * xkernel[j] else wt = wt - xkernel[j] } out[i] = out[i] + val wts[i] = wts[i] + wt save[i] = val wtsave[i] = wt } } else { if (fp_equalr (1., scale)) { do i = 1, nc { out[i] = out[i] + save[i] wts[i] = wts[i] + wtsave[i] } } else { do i = 1, nc { out[i] = out[i] + scale * save[i] wts[i] = wts[i] + scale * wtsave[i] } } } end # ASUBR_SCALE -- out = in1 * scale1 - in2 * scale2 procedure asubr_scale (in1, scale1, in2, scale2, out, n) real in1[n] #I Input vector real scale1 #I Scale real in2[n] #I Input vector real scale2 #I Scale real out[n] #O Output vector int n #I Number of points int i begin if (scale1 == 1. && scale2 == 1.) call asubr (in1, in2, out, n) else if (scale1 == 1.) { do i = 1, n out[i] = in1[i] - in2[i] * scale2 } else if (scale2 == 1.) { do i = 1, n out[i] = in1[i] * scale1 - in2[i] } else { do i = 1, n out[i] = in1[i] * scale1 - in2[i] * scale2 } end procedure cnvgline1 (line, offset, im, bpm, imdata, bp) int line #I Line to be read int offset[2] #I Offsets pointer im[2] #I Image pointers pointer bpm[2] #I Bad pixel mask pointers pointer imdata[2] #U Image data pointer bp #U Bad pixel data bool overlap int nl1, nl2, loff, l2 int nc1, nc2, nc3, off1, off2, off3, c1, c2 pointer imgl2r(), imgl2i() begin # Get data for first image. Use IMIO buffers except the # bad pixel buffer is not used if there is a second image. imdata[1] = imgl2r (im[1], line) if (bpm[1] != NULL) { if (im[2] == NULL) bp = imgl2i (bpm[1], line) else call amovi (Memi[imgl2i(bpm[1],line)], Memi[bp], IM_LEN(bpm[1],1)) } if (im[2] == NULL) return # Initialize. if (line == 1) { nc1 = IM_LEN(im[1],1) nc2 = IM_LEN(im[2],1) nl1 = IM_LEN(im[1],2) nl2 = IM_LEN(im[2],2) overlap = true if (1-offset[1] < 1 || nc1-offset[1] > nc2) overlap = false if (1-offset[2] < 1 || nl1-offset[2] > nl2) overlap = false off2 = -offset[1] c1 = max (1, 1+off2) c2 = min (nc2, nc1+off2) nc2 = c2 - c1 + 1 off1 = c1 - off2 - 1 off3 = c2 - off2 off2 = max (0, off2) nc3 = nc1 - off3 if (off1 > 0) { call aclrr (Memr[imdata[2]], off1) if (bpm[1] == NULL) call amovki (1, Memi[bp], off1) } if (nc3 > 0) { call aclrr (Memr[imdata[2]+off3], nc3) if (bpm[1] == NULL) call amovki (1, Memi[bp+off3], nc3) } loff = -offset[2] if (loff < 0) call aclrr (Memr[imdata[2]], nc1) } l2 = line + loff if (l2 < 1 || l2 > nl2) { call amovki (1, Memi[bp], nc1) return } if (overlap) { imdata[2] = imgl2r (im[2], l2) + off2 if (bpm[1] != NULL && bpm[2] != NULL) call amaxi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp], Memi[bp], nc1) else if (bpm[2] != NULL) call amovi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp], nc1) } else { # Copy the overlapping parts of the second image to the output # buffers which must be allocated externally. Use the bad pixel # mask to flag regions where there is no overlap. call amovr (Memr[imgl2r(im[2],l2)+off2], Memr[imdata[2]+off1], nc2) if (bpm[1] != NULL && bpm[2] != NULL) { call amaxi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp+off1], Memi[bp+off1], nc2) if (off1 > 0) call amovki (1, Memi[bp], off1) if (nc3 > 0) call amovki (1, Memi[bp+off3], nc3) } else if (bpm[2] != NULL) call amovi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp+off1], nc2) } end procedure cnvgline2 (line, offset, im, skymap, sigmap, expmap, skydata, sigdata, expdata) int line #I Line to be read int offset[2] #I Offsets pointer im[2] #I Image pointers pointer skymap[2] #I Sky map pointer sigmap[2] #I Sky sigma map pointer expmap[2] #I Exposure map pointer skydata[2] #U Sky data pointer sigdata[2] #U Sky sigma data pointer expdata[2] #U Exposure map data bool overlap int nl1, nl2, loff, l2 int nc1, nc2, nc3, off1, off2, off3, c1, c2 pointer ptr pointer map_glr() errchk map_glr begin # Get data for first image. skydata[1] = map_glr (skymap[1], line, READ_ONLY) if (expmap[1] == NULL) sigdata[1] = map_glr (sigmap[1], line, READ_ONLY) else { sigdata[1] = map_glr (sigmap[1], line, READ_WRITE) expdata[1] = map_glr (expmap[1], line, READ_ONLY) call expsigma (Memr[sigdata[1]], Memr[expdata[1]], IM_LEN(im[1],1), 0) } if (im[2] == NULL) return # Initialize. if (line == 1) { nc1 = IM_LEN(im[1],1) nc2 = IM_LEN(im[2],1) nl1 = IM_LEN(im[1],2) nl2 = IM_LEN(im[2],2) overlap = true if (1-offset[1] < 1 || nc1-offset[1] > nc2) overlap = false if (1-offset[2] < 1 || nl1-offset[2] > nl2) overlap = false off2 = -offset[1] c1 = max (1, 1+off2) c2 = min (nc2, nc1+off2) nc2 = c2 - c1 + 1 off1 = c1 - off2 - 1 off3 = c2 - off2 nc3 = nc1 - off3 if (off1 > 0) { call aclrr (Memr[skydata[2]], off1) call aclrr (Memr[sigdata[2]], off1) if (expmap[2] != NULL) call aclrr (Memr[expdata[2]], off1) } if (nc3 > 0) { call aclrr (Memr[skydata[2]+off3], nc3) call aclrr (Memr[sigdata[2]+off3], nc3) if (expmap[2] != NULL) call aclrr (Memr[expdata[2]+off3], nc3) } loff = -offset[2] if (loff < 0) { call aclrr (Memr[skydata[2]], nc1) call aclrr (Memr[sigdata[2]], nc1) if (expmap[2] != NULL) call aclrr (Memr[expdata[2]], nc1) } } l2 = line + loff if (l2 < 1 || l2 > nl2) return if (overlap) { skydata[2] = map_glr (skymap[2], l2, READ_ONLY) + off2 if (expmap[2] == NULL) sigdata[2] = map_glr (sigmap[2], l2, READ_ONLY) + off2 else { sigdata[2] = map_glr (sigmap[2], l2, READ_WRITE) + off2 expdata[2] = map_glr (expmap[2], l2, READ_ONLY) + off2 call expsigma (Memr[sigdata[2]], Memr[expdata[2]], nc2, 0) } } else { # Copy the overlapping parts of the second image to the output # buffers which must be allocated externally. ptr = map_glr(skymap[2],l2,READ_ONLY) call amovr (Memr[ptr+off2], Memr[skydata[2]+off1], nc2) ptr = map_glr(sigmap[2],l2,READ_ONLY) call amovr (Memr[ptr+off2], Memr[sigdata[2]+off1], nc2) if (expmap[2] != NULL) { ptr = map_glr(expmap[2],l2,READ_ONLY) call amovr (Memr[ptr+off2], Memr[expdata[2]+off1], nc2) call expsigma (Memr[sigdata[2]], Memr[expdata[2]], nc2, 0) } } end # CNVPARSE -- Parse convolution string. procedure cnvparse (cnvstr, kernel, nx, ny, logfd) char cnvstr[ARB] #I Convolution string pointer kernel #O Pointer to convolution kernel elements int nx, ny #O Convolution size int logfd #I Log file descriptor int i, j, nx2, ny2 int ip, fd, open(), fscan(), nscan(), ctor(), ctoi(), strncmp() real val, sx, sy pointer ptr errchk open define unknown_ 10 begin kernel = NULL for (ip=1; IS_WHITE(cnvstr[ip]); ip=ip+1) ; if (cnvstr[ip] == EOS) { nx = 1 ny = 1 call malloc (kernel, 1, TY_REAL) Memr[kernel] = 1 } else if (cnvstr[ip] == '@') { fd = open (cnvstr[ip+1], READ_ONLY, TEXT_FILE) call malloc (kernel, 100, TY_REAL) i = 0 nx = 0 ny = 0 while (fscan (fd) != EOF) { do j = 1, ARB { call gargr (val) if (nscan() < j) break Memr[kernel+i] = val i = i + 1 if (mod (i, 100) == 0) call realloc (kernel, i+100, TY_REAL) } j = j - 1 if (nx == 0) nx = j else if (j != nx) { call close (fd) call error (1, "Number of convolution elements inconsistent") } ny = ny + 1 } call close (fd) } else if (IS_ALPHA(cnvstr[ip])) { if (strncmp ("block", cnvstr[ip], 5) == 0) { i = 6 if (ctoi (cnvstr[ip], i, nx) == 0 || ctoi (cnvstr[ip], i, ny) == 0) goto unknown_ call malloc (kernel, nx*ny, TY_REAL) call amovkr (1., Memr[kernel], nx*ny) } else if (strncmp ("bilinear", cnvstr[ip], 8) == 0) { i = 9 if (ctoi (cnvstr[ip], i, nx) == 0 || ctoi (cnvstr[ip], i, ny) == 0) goto unknown_ call malloc (kernel, nx*ny, TY_REAL) nx2 = nx / 2 ny2 = ny / 2 ptr = kernel do j = 0, ny-1 { do i = 0, nx-1 { Memr[ptr] = (nx2-abs(nx2-i)+1) * (ny2-abs(ny2-j)+1) ptr = ptr + 1 } } } else if (strncmp ("gauss", cnvstr[ip], 5) == 0) { i = 6 if (ctoi (cnvstr[ip], i, nx) == 0 || ctoi (cnvstr[ip], i, ny) == 0) goto unknown_ if (ctor (cnvstr[ip], i, sx) == 0 || ctor (cnvstr[ip], i, sy) == 0) goto unknown_ call malloc (kernel, nx*ny, TY_REAL) nx2 = nx / 2 ny2 = ny / 2 val = 2 * sx * sy ptr = kernel do j = 0, ny-1 { do i = 0, nx-1 { Memr[ptr] = exp (-((i-nx2)**2+(j-ny2)**2) / val) ptr = ptr + 1 } } } } else { call malloc (kernel, 100, TY_REAL) i = 0 nx = 0 ny = 0 while (cnvstr[ip] != EOS) { do j = 1, ARB { if (ctor (cnvstr, ip, val) == 0) break Memr[kernel+i] = val i = i + 1 if (mod (i, 100) == 0) call realloc (kernel, i+100, TY_REAL) } j = j - 1 if (nx == 0) nx = j else if (j != nx) call error (1, "Number of convolution elements inconsistent") ny = ny + 1 if (cnvstr[ip] != EOS) ip = ip + 1 for (; IS_WHITE(cnvstr[ip]); ip=ip+1) ; } } if (kernel == NULL) unknown_ call error (1, "Unrecognized convolution") if (mod (nx, 2) != 1 || mod (ny, 2) != 1) { call mfree (kernel, TY_REAL) call error (1, "Convolution size must be odd") } if (logfd != NULL) { ptr = kernel call eprintf (" Convolution:\n") do j = 1, ny { call eprintf (" ") do i = 1, nx { call eprintf (" %7.3g") call pargr (Memr[ptr]) ptr = ptr + 1 } call eprintf ("\n") } } end