c this file contains subroutines inputimag, outputimag, and alarm c c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: c c c subroutine inputimag(inimage,error) c c c c....................................................................... c c author: Christopher W. Churchill c c history: 20-Jan94 created, CWC c c purpose: read the input image, get the image size, and load the c pix array values c c input: inimage = IRAF input image name c c output: nrows = number of rows in image c ncols = number of columns in image c pix = input image pixel values [DN] c c I/O: standard output on error (in routione alarm) c c options: none c c routines called: IMFORT - imopen, imgsiz, imgl2r, imclos c INTERNAL - alarm c c description: interface with the IMFORT library and read in the image c into the array pix ; error flagging is performed and if c an IMFORT error is encountered the internal subroutine c "alarm" is called. help files within IRAF explain the c IMFORT parameter lists and routine calls invoked here. c c NOTE: the datatype of pix must be "real", not "double c precision" as used throughout this module c c....................................................................... c implicit undefined (a-z) logical error integer irow,naxis,ier,inim,axlen(7),dtype character*80 inimage include 'hamscatt.par' include 'hamscatt.com' c c c c c c open image (1=read-only) ; error trap call imopen(inimage,1,inim,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if c c get dimensions and datatype ; error trap call imgsiz(inim,axlen,naxis,dtype,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if c c get image dimensions ; read pix line by line ; error trap ncols = axlen(1) nrows = axlen(2) do 03 irow=1,nrows call imgl2r(inim,pix(1,irow),irow,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if 03 continue c c close image ; error trap call imclos(inim,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if c c enforce consistency between input deck, common block physical c dimensions and working array physical dimensions if (ncols.gt.maxcols) then write(stdout,*) ' ERROR: number of image columns is greater' write(stdout,*) ' than MAXCOLS.' error = .true. end if if (nrows.gt.maxrows) then write(stdout,*) ' ERROR: number of image rows is greater' write(stdout,*) ' than MAXROWS.' error = .true. end if c return end c c....................................................................... c c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: c c c subroutine outputimag(inimage,outimage,error) c c c c....................................................................... c c author: Christopher W. Churchill c c history: 20-Jan94 created, CWC c c purpose: open and output the background illumination image c c input: inimage = IRAF input image name c pix = background illumination pixel values [DN] c c output: outimage = IRAF output image of background surface c error = (logical) error flag c c I/O: standard output on error (in routine alarm) c c options: none c c routines called: IMFORT - imopen, imopnc, impl2r, imclos c INTERNAL - alarm c c description: interface with the IMFORT library and output the image c stored in array pix ; error flagging is performed and if c an IMFORT error is encountered the internal subroutine c "alarm" is called. help files within IRAF explain the c IMFORT parameter lists and routine calls invoked here. c c....................................................................... c implicit undefined (a-z) logical error integer irow,ier,inim,outim character*80 inimage,outimage include 'hamscatt.par' include 'hamscatt.com' c c c c c c first, open the input image ; error trap 01 call imopen(inimage,1,inim,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if c c create output image ; copy input image header ; error trap c WARNING. it is assumed that an imopnc error is due to a c noclobber setting, which we trap for recoverablility call imopnc(outimage,inim,outim,ier) if (ier.ne.0) then call alarm(ier) call imclos(inim,ier) write(stdout,1000) read(stdin,*) outimage goto 01 end if 1000 format(1x,'ENTER a different output image name : ',$) c c close input image ; error trap call imclos(inim,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if c c write out buffer line by line ; error trap do 03 irow=1,nrows call impl2r(outim,pix(1,irow),irow,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if 03 continue c c close output image ; error trap call imclos(outim,ier) if (ier.ne.0) then call alarm(ier) error = .true. return end if c c return end c c c c....................................................................... c c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: c c c subroutine alarm(ier) c c c c....................................................................... c c author: Christopher W. Churchill c c history: 20-Jan94 created, CWC c c purpose: error interpretation of IMFORT library error messages c c input: ier = IMFORT error code c c output: standard output error message c c I/O: standard output c c options: none c c routines called: IMFORT - imemsg c c description: interface the IMFORT library error message interpreter c and communicate the error ; allow the use to terminate c program or continue c c....................................................................... c implicit undefined (a-z) integer ier character*80 errmsg include 'hamscatt.par' c c c c c c call the IMFORT error code "translator" and spit-it-out call imemsg(ier,errmsg) write(stdout,600) errmsg c c format 600 format(1x,/,1x,'IMFORT Error: ',a) c c return end c c....................................................................... c..eof