SUBROUTINE ZDCAL C C Module Number: 13.7.1 C C Module Name: ZDCAL C C Keyphrase: C ---------- C Compute HRS Diode response C C Description: C ------------ C Using observations of the Internal HRS flat field lamp, This routine C computes the diode to diode response. The typical input observations C will be a PMAP of the photocathode (i.e Y-scan). ZDCAL will coadd C lines from a number of different y deflections to average out photocathode C granularities. Low frequency photocathode variations and variations C in the Lamp intensity are then removed by least squares cubic splines. C In the event there are any large photocathode C blemishes, The input observations are divided into sets, and a response C is computed for each set. An average of all sets are taken with the C worst point for each diode not used. C C C FORTRAN Name: zdcal.for C C C Keywords of Accessed Files : C -------------------------- C C INPUT input Input raw science observation template C EETRAILER input Input trailer file template C TEMPLATE input Diode response template file C DIODEMAP output Diode response file. C C Modules Called: C --------------- C CDBS: C zdrfit, zdave, ztplat C SDAS: * uclgs* , umsput * uimotp, uimxtp, uimctp, uimopn, uimgid, uimclo, uhdgs* uimclo C OTHERS: C C History: C -------- C Version Date Author Description C 1 1 May 86 D. Lindler Design and coded C 2 27 Jul 86 D. Lindler Added detector consistency check C and added detector to output C file header (SPR-35) C 2 Apr 88 D. Lindler New SDAS I/O and standards C------------------------------------------------------------------------ C Data Declaration C C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) C C UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87 C INTEGER STDOUT PARAMETER (STDOUT = 1) INTEGER STDERR PARAMETER (STDERR = 2) C END IRAF77.INC C C ERROR PROCESSING PARAMETERS C INTEGER STATUS,ISTAT,ISTATS(20) C ---> STATUS INDICATOR CHARACTER*130 CONTXT C ---> STATUS MESSAGE C C INPUT FILE I/O C CHARACTER*130 INPUT,EETRL C --->TEMPLATES CHARACTER*64 NAME,ENAME,TMPLT C --->FILE NAMES INTEGER IDTEMP,IDTMP2 C --->TEMPLATE IDS INTEGER IDIN,IDIN2 C --->FILE IDS INTEGER NAXIS,DTYPE,DIMEN(8) C --->DATA DESCRIPTIONS DOUBLE PRECISION DATA(500),ET(24) C --->DATA BUFFERS C C OUTPUT FILE C CHARACTER*64 DNAME INTEGER IDOUT DOUBLE PRECISION DRESP(512) C --->DIODE RESPONSES C C KEYWORD PARAMETERS C INTEGER NITER C --->NUMBER OF SPLINE ITERATIONS INTEGER NODES C --->NUMBER OF SPLINE NODES INTEGER SETSIZ C --->NUMBER OF OBS. IN EACH SET C C C LOCAL VARIABLES C DOUBLE PRECISION BIG(512,15) C ---> UP TO 15 DIODE RESP. SETS INTEGER NOBS(15) C ---> NUMBER OF OBS IN EACH SET INTEGER I,J C ---> INDICES INTEGER NSETS C ---> NUMBER OF SETS OF OBSERVATIONS INTEGER IDET,DET C ---> DETECTOR NUMBERS LOGICAL FIRST C ---> FIRST OBSERVATION? C---------------------------------------------------------------------------- C C GET INPUT PARAMETERS C CALL UCLGST('input',INPUT,ISTATS(1)) CALL UCLGST('eetrailer',EETRL,ISTATS(2)) CALL UCLGST('diodemap',DNAME,ISTATS(3)) CALL UCLGSI('setsize',SETSIZ,ISTATS(4)) CALL UCLGSI('nodes',NODES,ISTATS(5)) CALL UCLGSI('niter',NITER,ISTATS(6)) CALL UCLGST('template',TMPLT,ISTATS(7)) DO 5 I=1,7 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting cl parameter' GO TO 999 ENDIF 5 CONTINUE C C INITIALIZATION ---------------------------------------------------------- C FIRST=.TRUE. NSETS=1 DO 10 I=1,15 NOBS(I)=0 DO 8 J=1,512 BIG(J,I)=0.0D0 8 CONTINUE 10 CONTINUE C C C OPEN TEMPLATES C CALL UIMOTP(INPUT,IDTEMP,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input filename template '//INPUT GO TO 999 ENDIF CALL UIMOTP(EETRL,IDTMP2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening trailer file template '//EETRL GO TO 999 ENDIF C C GET NEXT FILE NAME C 20 CALL UIMXTP(IDTEMP,NAME,ISTAT) IF(ISTAT.LT.0)GO TO 100 IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//INPUT GO TO 999 ENDIF C C GET NEXT trailer file NAME C CALL UIMXTP(IDTMP2,ENAME,ISTAT) IF(ISTAT.LT.0)THEN CONTXT='Insufficent trailer files specified' GO TO 999 ENDIF IF(ISTAT.NE.0)THEN CONTXT='Error getting filename from template '//EETRL GO TO 999 ENDIF C C OPEN INPUT FILES C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input file '//NAME GO TO 999 ENDIF CALL UIMOPN(ENAME,RDONLY,IDIN2,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening trailer file '//ENAME GO TO 999 ENDIF C C READ IMAGE INFO C CALL UIMGID(IDIN,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).GT.500))THEN CONTXT='Input data must vector with 500 values' GO TO 999 ENDIF C C READ TRAILER FILE INFO C CALL UIMGID(IDIN2,DTYPE,NAXIS,DIMEN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading trailer file '//ENAME GO TO 999 ENDIF C C CHECK FOR VALID DATA C IF((NAXIS.NE.1).OR.(DIMEN(1).NE.24))THEN CONTXT='Invalid trailer file '//ENAME GO TO 999 ENDIF C C READ DATA C CALL UIGL1D(IDIN,DATA,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//NAME GO TO 999 ENDIF CALL UIGL1D(IDIN2,ET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error reading input file '//ENAME GO TO 999 ENDIF C C GET DETECTOR NUMBER C CALL UHDGSI(IDIN,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error getting detector number from '//NAME GO TO 999 ENDIF IF(FIRST)IDET=DET FIRST=.FALSE. IF(DET.NE.IDET)THEN CONTXT='ERROR: All observations not same detector' GO TO 999 ENDIF C C START A NEW SET? C IF(NOBS(NSETS).EQ.SETSIZ)NSETS=NSETS+1 IF(NSETS.GT.15)THEN CONTXT='Error: too many sets of input observations, '// * 'increase SETSIZE' GO TO 999 ENDIF C C ADD DATA TO SET SUMS C NOBS(NSETS)=NOBS(NSETS)+1 DO 50 I=1,500 BIG(I+6,NSETS)=BIG(I+6,NSETS)+DATA(I) C --->MAIN DIODE ARRAY 50 CONTINUE DO 60 I=1,6 BIG(I,NSETS)=BIG(I,NSETS)+ET(I) C --->LEFT SPECIAL DIODES BIG(I+506,NSETS)=BIG(I+506,NSETS)+ET(I+6) C --->LEFT SPECIAL DIODES 60 CONTINUE C C CLOSE IMAGES C CALL UIMCLO(IDIN,ISTAT) CALL UIMCLO(IDIN2,ISTAT) C C GO GET NEXT IMAGE C GO TO 20 100 CONTINUE C C DONE READING INPUT DATA ------------------------------------------------ C IF(NOBS(NSETS).EQ.0)NSETS=NSETS-1 IF(NSETS.LE.0)THEN CONTXT='No files found in input template' GO TO 999 ENDIF C C COMPUTE RESPONSES FOR EACH SET C CALL ZDRFIT(BIG,NSETS,NODES,NITER,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR COMPUTING DIODE RESPONSE' GO TO 999 ENDIF C C COMPUTE AVERAGE RESPONSE C CALL ZDAVE(BIG,512,NSETS,DRESP,STATUS) IF(STATUS.NE.0)THEN CONTXT='ERROR IN AVERAGING RESPONSES' GO TO 999 ENDIF C C CREATE OUTPUT FILE FROM TEMPLATE C CALL ZTPLAT(TMPLT,DNAME,DRESP,512,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Unable to write diode response file' GO TO 999 ENDIF C C ADD DETECTOR TO OUTPUT HEADER C CALL UHDPSI(IDOUT,'DETECTOR',DET,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR writing detector number to output file' GO TO 999 ENDIF C C CLOSE OUTPUT FILE C CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR closing output file' GO TO 999 ENDIF C C DONE C CALL UIMCTP(IDTEMP,ISTAT) CALL UIMCTP(IDTMP2,ISTAT) GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END