SUBROUTINE ZPCCAL C C Module Number: 13.7.2 C C Module Name: ZPCCAL C C Keyphrase: C ---------- C Compute HRS photocathode granularity C C Description: C ------------ C Using observations of standard stars at nearly the same photocathode C line position, the photocathode granularity is computed by summing C the observations and using a cubic spline through through the raw data to C smooth the data and remove low frenquency variations. Input data C must be taken with comb-addition and previously corrected for C diode non_uniformities and non_linearities. C The photocathode mapping function must also have been previously C computed. C C C FORTRAN Name: zpccal.for C C C Keywords of Accessed Files : C -------------------------- C INPUT input Input (merged and corrected for diode resp.) C AVEFILE output Total averaged counts C SMOOTHFILE output Smoothed curve through averaged counts C CATHODEMAP output Photocathode response C NODES input Number of spline nodes C NITER input Number of iterations for least sqaures fit C Modules Called: C --------------- C CDBS: C zpcfit 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 28 JUL 86 D. Lindler Added detector and grating checks. C Added det./grating to output header C (SPR-38) C 3 April 88 D. Linder New sdas I/O and standards C 3.1 Jan 92 S. Hulbert New grating values C 3.2 April 93 J. Eisenhamer Removed unused variable STATUS C------------------------------------------------------------------------ C Data Declaration C C C FILE I/O ACCESS MODES C INTEGER RDONLY PARAMETER (RDONLY = 1) INTEGER TYREAL PARAMETER (TYREAL = 6) 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 INPUT KEYWORD PARAMETERS C CHARACTER*64 AVEFIL,CMAP,TMPLT,SMFILE INTEGER NODES,NITER C C ERROR PROCESSING PARAMETERS C INTEGER ISTAT,ISTATS(20) C ---> STATUS INDICATOR CHARACTER*130 CONTXT C ---> STATUS MESSAGE C C INPUT FILE I/O C CHARACTER*130 INPUT,NAME INTEGER IDTEMP,IDIN,NAXIS,DTYPE,DIMEN(8),NS,IDOUT C C DATA BUFFERS FOR OUTPUT SAMP/RESPONSE C DOUBLE PRECISION SAMP(2240),TOTAL(2240),AVE(2240),RESP(2240), * INTERP(2240),SMOOTH(2240) INTEGER NADDS(2240) C C DATA BUFFERS FOR INPUT DATA C DOUBLE PRECISION SDATA(2000),DATA(2000) C C HEADER PARAMETERS C CHARACTER*8 HEADER(5) INTEGER DET1,DET C ---> DETECTOR NUMBER CHARACTER*5 GRAT1,GRAT C ---> GRATING DOUBLE PRECISION SAMPLE,DELTAS,LINE C C OUTPUT LINE POSITION COMPUTATION C DOUBLE PRECISION TOTLIN INTEGER NLINES C C OTHERS C INTEGER I DOUBLE PRECISION MINS,MAXS C C DATA DECLARATIONS C DATA HEADER/'DETECTOR','GRATING','SAMPLE','DELTAS','LINE'/ C------------------------------------------------------------------------ C C INITIALIZATION C DO 1 I=1,2240 SAMP(I)=I/4.0 C --->QUARTER STEPPED RESPONSE TOTAL(I)=0.0D0 NADDS(I)=0 1 CONTINUE TOTLIN=0.0D0 NLINES=0 C C GET CL PARAMETERS ------------------------------------------------------- C CALL UCLGST('input',INPUT,ISTATS(1)) CALL UCLGST('avefile',AVEFIL,ISTATS(2)) CALL UCLGST('smoothfile',SMFILE,ISTATS(3)) CALL UCLGST('cathodemap',CMAP,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 LOOP ON INPUT OBSERVATIONS AND COADD DATA TO TOTAL ARRAY-------------- C C C OPEN TEMPALTE C CALL UIMOTP(INPUT,IDTEMP,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening input filename template '//INPUT 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 OPEN INPUT FILE C CALL UIMOPN(NAME,RDONLY,IDIN,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error opening file '//NAME 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 NS=DIMEN(1) IF((NAXIS.NE.1).OR.(NS.GT.2000))THEN CONTXT='Input data must vectors with 2000 or fewer points' 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 C C GET HEADER PARAMETERS C CALL UHDGSI(IDIN,'DETECTOR',DET,ISTATS(1)) CALL UHDGST(IDIN,'GRATING',GRAT,ISTATS(2)) CALL UHDGSD(IDIN,'SAMPLE',SAMPLE,ISTATS(3)) CALL UHDGSD(IDIN,'DELTAS',DELTAS,ISTATS(4)) CALL UHDGSD(IDIN,'LINE',LINE,ISTATS(5)) DO 50 I=1,5 IF(ISTATS(I).NE.0)THEN CONTXT='Error getting header parameter '//HEADER(I)// * ' from file '//NAME GO TO 999 ENDIF 50 CONTINUE C C CHECK CONSISTENCY C IF(NLINES.EQ.0)THEN GRAT1=GRAT DET1=DET ENDIF IF(GRAT1.NE.GRAT)THEN CONTXT='ALL OBS. NOT FOR SAME GRATING MODE' GO TO 999 ENDIF IF(DET1.NE.DET)THEN CONTXT='ALL OBS. NOT FOR SAME DETECTOR' GO TO 999 ENDIF C C GENERATE SAMPLE ARRAY FOR INPUT DATA C DO 60 I=1,NS 60 SDATA(I)=SAMPLE+DELTAS*(I-1) MINS=SDATA(1) MAXS=SDATA(NS) C C TOTAL LINE POSITIONS C TOTLIN=TOTLIN+LINE NLINES=NLINES+1 C C INTERPOLATE TO MATCH OUTPUT SAMPLE ARRAY C CALL ZLINTP(SDATA,DATA,NS,SAMP,INTERP,2240,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error interplating to output sample scale' GO TO 999 ENDIF C C COADD DATA C DO 70 I=1,2240 IF((SAMP(I).GE.MINS).AND.(SAMP(I).LE.MAXS))THEN TOTAL(I)=TOTAL(I)+INTERP(I) NADDS(I)=NADDS(I)+1 ENDIF 70 CONTINUE C C CLOSE IMAGE C CALL UIMCLO(IDIN,ISTAT) C C GO GET NEXT IMAGE C GO TO 20 100 CONTINUE C C DONE READING INPUT DATA ------------------------------------------------ C IF(NLINES.EQ.0)THEN CONTXT='No files found in input template' GO TO 999 ENDIF C C COMPUTE RESPONSE C CALL ZPCFIT(SAMP,TOTAL,NADDS,2240,NODES,NITER,AVE, * SMOOTH,RESP,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR COMPUTING RESPONSE VECTOR' GO TO 999 ENDIF C C WRITE OUTPUT AVERAGE FILE ------------------------------------------------ C CALL UIMCRE(AVEFIL,TYREAL,1,2240,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR creating output AVEFILe '//AVEFIL GO TO 999 ENDIF CALL UIPL1D(IDOUT,AVE,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR writing to output file '//AVEFIL GO TO 999 ENDIF CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output file '//AVEFIL GO TO 999 ENDIF C C WRITE OUTPUT SMOOTHED AVERAGE FILE ----------------------------------------- C CALL UIMCRE(SMFILE,TYREAL,1,2240,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR creating output smoothfile '//SMFILE GO TO 999 ENDIF CALL UIPL1D(IDOUT,SMOOTH,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='ERROR writing to output file '//SMFILE GO TO 999 ENDIF CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output file '//SMFILE GO TO 999 ENDIF C C WRITE OUTPUT RESPONSE FILE USING INPUT TEMPALTE C CALL ZTPLAT(TMPLT,CMAP,RESP,2240,IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error writing output response file' GO TO 999 ENDIF C C UPDATE HEADER PARAMETERS C CALL UHDPST(IDOUT,'GRATING',GRAT,ISTATS(1)) CALL UHDPSI(IDOUT,'NUMLINE',1,ISTATS(2)) CALL UHDPSI(IDOUT,'NUMSAMP',2230,ISTATS(4)) TOTLIN=TOTLIN/NLINES CALL UHDPSD(IDOUT,'LINEBEG',TOTLIN,ISTATS(4)) CALL UHDPSD(IDOUT,'LINEOFF',0.0D0,ISTATS(5)) CALL UHDPSD(IDOUT,'SAMPBEG',0.0D0,ISTATS(6)) CALL UHDPSD(IDOUT,'SAMPOFF',0.25D0,ISTATS(7)) DO 400 I=1,7 IF(ISTATS(I).NE.0)THEN CONTXT='ERROR updating response file header' GO TO 999 ENDIF 400 CONTINUE CALL UIMCLO(IDOUT,ISTAT) IF(ISTAT.NE.0)THEN CONTXT='Error closing output response file' GO TO 999 ENDIF C C C DONE C GO TO 1000 999 CALL UMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT) 1000 RETURN END