SUBROUTINE ZFF1(DATA,MASK1,MASK2,N,I1,I2,MINVAL,NODES, * XNODE,DNODE,NITER,DOFIT,FIT,FF,FFMASK,STATUS) * * Module Number: 14.7.1 * * Module Name: ZFF1 * * Keyphrase: * ---------- * GHRS flat field computation * * Description: * ------------ * This routine computes the GHRS flat field response by dividing * the input data by a smoothed version. The data is smoothed by * a least squares fit of a cubic spline with a spcified number * of nodes. Points outside of the range I1 to I2, and points * with MASK1 set to zero are not computed. Their response is * set to 1.0. Also points with a data value less then MINVAL * are set to 1.0. Points with mask1 or mask2 set to zero are * not used in computation of the smoothed curve. * * Fortran Name: zff1 * * Keywords of accessed files and tables: * -------------------------------------- * none * * Subroutines Called: * ------------------- * CDBS: * zspfit, zsplin * SDAS: * umsput * * History: * -------- * version date Author Description * 1 3/23/87 D. Lindler Designed and coded * 2 MAy 88 D. Lindler New sdas i/o and standards *------------------------------------------------------------------------- * * INPUT PARAMETERS * * data - input data array of counts (real*8) * mask1 - mask array of bad pixels (real*8) * mask2 - mask array of blemishes (real*8) * n - number of points in arrays (integer) * i1 - first data point to process (integer) * i2 - last data point to process (integer) * minval - minimum allowed data value (real*8) * nodes - number of nodes in spline (integer) * xnode - x coords of nodes if read in from file (real*8) * dnode - y coords of nodes if read in from file (real*8) * niter - number of iterations of fit routine (integer) * dofit - perform least squares fit of spline to data? (logical) * * OUTPUT PARAMETERS * * fit - fitted curve (real*8) * ff - flat field vector (real*8) * ffmask - mask vector for ff (real*8) * status - error status (integer) * C C UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87 C INTEGER STDOUT PARAMETER (STDOUT = 1) INTEGER STDERR PARAMETER (STDERR = 2) INTEGER USRLOG PARAMETER (USRLOG = 4) C END IRAF77.INC DOUBLE PRECISION DATA(2500),MASK1(2500),MASK2(2500),XNODE(30), * DNODE(30),FIT(2500),FF(2500),FFMASK(2500),MINVAL INTEGER I1,I2,NODES,N,NITER,STATUS LOGICAL DOFIT * * LOCAL VARIABLES C DOUBLE PRECISION XGOOD(2500),DGOOD(2500),XPIX(2500) CHARACTER*130 CONTXT CHARACTER*61 DEVICE INTEGER GP, GT INTEGER NGOOD,I,ISTAT DOUBLE PRECISION DELX,SUM,AVE C C LOCAL PARAMETER DEFINITIONS C INTEGER POINT PARAMETER (POINT=1) INTEGER PLUS PARAMETER (PLUS=2) INTEGER LINE PARAMETER (LINE=3) C------------------------------------------------------------------------- C C EXTRACT DATA POINTS TO BE FIT AND COMPUTE SUM OF GOOD NODES C NGOOD=0 DO 10 I=1,N XPIX(I) = I IF((I.GE.I1).AND.(I.LE.I2).AND.(MASK1(I).NE.0.0) * .AND.(MASK2(I).NE.0.0))THEN NGOOD=NGOOD+1 XGOOD(NGOOD)=I DGOOD(NGOOD)=DATA(I) SUM=SUM+DATA(I) ENDIF 10 CONTINUE C C CHECK IF ENOUGH GOOD POINTS C IF(NGOOD.LT.(NODES+1))THEN CONTXT='NOT ENOUGH VALID POINTS TO PERFORM SPLINE FIT' GO TO 999 ENDIF C C COMPUTE NODE POSITIONS C C IF XNODE < 0 THEN WE READ IN NODES FROM A FILE, OTHERWISE CALCULATE C IF(XNODE(1).LT.0.D0) THEN AVE=SUM/NGOOD DELX=(XGOOD(NGOOD)-XGOOD(1))/(NODES-1) DO 20 I=1,NODES XNODE(I)=XGOOD(1)+(I-1)*DELX DNODE(I)=AVE 20 CONTINUE ENDIF C C THE FOLLOWING LOOP ALLOWS THE USER TO ADD OR DELETE NODES, AND C THEN REFIT THE DATA AND REDISPLAY C C Begin Loop STATUS = 0 30 IF (STATUS.EQ.0) THEN CALL SPINIT(GP,GT,XGOOD,DGOOD,NGOOD,DEVICE) C PLOT THE DATA, THE NODES AND THE FIT; ADD OR DELETE NODES. CALL SPPLOT(GP,GT,XGOOD,DGOOD,NGOOD,POINT) CALL SPPLOT(GP,GT,XNODE,DNODE,NODES,PLUS) CALL SPPLOT(GP,GT,XPIX,FIT,N,LINE) CALL SPCURS(GP,GT,XNODE,DNODE,NODES,STATUS) C C STATUS = -1 MEANS QUIT FROM CURSOR MODE IF (STATUS.EQ.-1) THEN STATUS=0 GOTO 70 ELSE IF (STATUS.NE.0) THEN CONTXT='Error adding or deleting nodes for spline' GOTO 999 ENDIF C C PERFORM A LEAST SQUARES FIT OF THE SPLINE Y-VALUES TO THE DATA? C IF (DOFIT) THEN C C PERFORM LEAST SQUARES FIT C CALL ZSPFIT(XGOOD,DGOOD,NGOOD,XNODE,DNODE,NODES,NITER,FIT, * STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR PERFORMING LEAST SQUARES SPLINE FIT' GO TO 999 ENDIF ENDIF C C COMPUTE FIT FOR ALL DATA POINTS C CALL ZSPLIN(XPIX,N,XNODE,DNODE,NODES,FIT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error computing spline for full data range' GO TO 999 ENDIF ENDIF C C Free graphics structures C CALL SPCLS(GP,GT) GOTO 30 70 CONTINUE C C COMPUTE RESPONSE C DO 100 I=1,N IF((I.LT.I1).OR.(I.GT.I2).OR.(DATA(I).LT.MINVAL).OR. * (MASK1(I).EQ.0.0).OR.(FIT(I).LE.0.0))THEN FF(I)=1.0 FFMASK(I)=0.0 ELSE FF(I)=DATA(I)/FIT(I) FFMASK(I)=1.0 ENDIF 100 CONTINUE C C DONE C STATUS=0 GO TO 1000 999 STATUS=1 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 CALL SPFREE(GP,GT) RETURN END