Dark Count Correction Program
73 ) OS/360 FORTRAN H
CER OPTIONS - NAME= MAIN,OPT=02,LINECNT=58,SIZE=0000K,
C SOURCE,EBCDIC,NOLIST,NODECK,LOAD,MAP,NOEDIT,ID,XREF
DEFINE FILE 32(72,665,U,K32)
C IF MON=1,U2 WAVELENGTHS WILL BE REPLACED BY U1 WAVELENGTHS FOR USE BY
C THE STACKING PROGRAM.
DIMENSION INFO(5500),LEN(3),TABLE( 7,95),WI(350),TIME(350),
X BACK(350),TOT(350),STAT(3,350),IWLT(350),ICS(350),ITIM(350),
X AWL(350),LTIME(350),IJJ(350),III(350),RATIO(10,3),JOF(7,95)
DATA RATIO/1.8,1.38,1.21,1.12,1.06,1.03,1.01,1.,1.,1.,2.68,1.74,
1 1.41,1.24,1.13,1.06,1.03,1.01,1.,1.,1.5,1.29,1.17,1.10,1.05,1.03
2 ,1.02,1.01,1.,1./
LOGICAL*1 STAT,USTNR
INTEGER*4 TABLE
COMPLEX*16 NAME(4)/
1'STAR NR ',
2'LAN ',
3'TUBE NR ',
4'ORBIT '/
COMMON /TROUT/ JNFO(100),STARN
COMMON/PSCALE/ MULT,F1,F2,F3
NAMELIST/INPUT/ IFMON,VSHIFT,KJUMP,KQUIT,STNR,USTNR
CALL INDUMP
C INITIALIZATION
KQUIT=100000
VSHIFT=0.0
USTNR=.FALSE.
STNR=0.00
SPDLHT=300000.0
C KM/SEC
NPTS1=0
ATIME=0.
NSER1=0
IFMON=0
N=4
IFLAG=0
KJUMP=0
NSER=0
LL=0
JS=0
TINE=0
JTINE=0
CALL SETUP(N,NAME,LEN,&1000)
READ(5,INPUT)
WRITE(6,INPUT)
MON=IFMON
100 CONTINUE
C PROGRAM CHECKS TO SEE IF IT SHOULD JUMP TO A SERIAL NO. OR START AT THE
C BEGINNING.
IF(KJUMP.EQ.0) GO TO 299
CALL HEADER(5500,INFO,&1001)
WRITE(6,30)
30 FORMAT(2X,'HEADER1')
CALL JUMP(KJUMP,&1001)
NSER=NSER+KJUMP
299 NSERO=NSER+1
C HEADER CALLS CONTROLLED HERE, INCLUDING CHECKS TO SEE IF KQUIT HAS BEEN
C REACHED OR TO SEE IF "STAR NUMBER" LOGIC IS TO BE USED. IF USTNR
C ("USE STAR NUMBER") IS .TRUE., CHECK FOR STAR NUMBER IS MADE.
300 NSER=NSER+1
IF(NSER.GT.KQUIT) GO TO 1002
CALL HEADER(5500,INFO,&1001)
IF(.NOT.USTNR) GO TO 413
IF(STNR.EQ.0.00) GO TO 1003
CALL ANUM(INFO,1,SNR)
IF(SNR.NE.STNR) GO TO 300
413 CALL SCAN(NPTS,WL,TIME,BACK,TOT,STAT)
CALL INUM(INFO,3,NTB)
IF(ABS(WL(NPTS) - WI(1)) .GT. .16 .AND. NTB .EQ.3) MON = 0
110 CALL ANUM(INFO,2,RLAN)
C IN THIS SECTION THE TIME DEPENDENCE IS TAKEN INTO ACCOUNT. DATA IN THE
C "DATA RATIO" CARDS AT THE BEGINNING OF THE PROGRAM, SPECIFIED EVERY 500
C ORBITS FROM 0 TO 4500 FOR V1, V2, AND V3 RESPECTIVELY ARE USED TO INFER
C "FACT."
CALL INUM(INFO,4,KTOB)
IF(KTOB.GT.4000) GO TO 298
IF(NTB.EQ.1)GO TO 298
IF(NTB.EQ.3)GO TO 298
IF(NTB.EQ.6)GO TO 298
IF(NTB.EQ.2) M=1
IF(NTB.EQ.4) M=2
IF(NTB.EQ.5) M=3
LT=KTOB/500
KT2=LT*500
AKDT=KTOB-KT2
AKDT=AKDT/500.
LT=LT+1
FACT=RATIO(LT,M)+AKDT*(RATIO(LT+1,M)-RATIO(LT,M))
GO TO 297
298 FACT=1.0
297 CONTINUE
C THE STANDARD ORBIT AND MINUTE DATA FOR THE FIRST DATA POINT ARE INFERRED,
C FOR PURPOSES OF PRINTOUT.
RL=-RLAN
RKK=TIME(1)/380.
KK=IFIX(RKK)
RL=RL-KK*(+25.335)
IF(RL.LT.0.0) RI=RI+360.0
RL1=RL
KU=RL/5 +1
READ(32'KU) TABLE
KR=(TIME(1)-(KK*380.)-2)/4+1
IF(TIME(1).LE.1) KR=0
KU1=KU
C THE DARK COUNT DATA FOR EACH POINT OF THE SCAN ARE DERIVED. LINEAR
C INTERPOLATION IN THE TABLE IS USED, WITH MAIN TABULATED POINTS
C CORRESPONDING TO 1.5 SETS INTO STANDARD ORBIT, 5.5, 9.5, 13.5, ETC.
C FOR SETS 0,1 (378,379), THE LAST POINT (FIRST POINT) OF THE LAST (NEXT)
C STANDARD ORBIT IS USED TO MAKE THE CROSSING INTO A NEW ORBIT IN THE
C TABLE SMOOTH.
DO 200 I=1,NPTS
RL=-RLAN
RKK=TIME(I)/380.
KK=IFIX(RKK)
RL=RL-KK*(+25.335)
IF(RL.LT.0.0) RL=RL+360.0
II=RL/5 +1
IF(II.NE.KU) READ(32'II) TABLE
IF(II.NE.KU) KU=II
TINE=(TIME(I)-KK*380.)
JTINE=TINE
JJ=(JTINE-2)/4+1
IF(JTINE.LE.1) JJ=0
IF(II.GT.72.OR.JJ.GT.95) GO TO 305
IF(JJ.EQ.JS) GO TO 405
IF(TINE.GT.1) GO TO 404
KN=(RL+25.335)/5+1
READ(32'KN) JOF
ZBK1=JOF(NTB,95)
ZBK2=(TABLE(NTB, 1)-ZBK1)/4.
GO TO 405
404 IF(TINE.LT.378) GO TO 406
ZBK1=TABLE(NTB,JJ)
KN=(RL-25.335)/5+1
READ(32'KN) JOF
ZBK2=(JOF(NTB,1)-ZBK1)/4.
GO TO 405
406 NMJ=JJ+1
ZBK1=TABLE(NTB,JJ)
ZBK2=(TABLE(NTB,NMJ)-ZBK1)/4.
405 GJJ=JJ
GIT=TINE-4.*GJJ+2.5
BACK(I)=(ZBK1+ZBK2*GIT)/FACT
JS=JJ
C IF "IFMON" IS 1 (SEE NAME LIST), U1 WAVELENGTHS ARE EQUATED TO U2
C WAVELENGTHS.
IF(MON.EQ.1.AND.NTB.EQ.1) AWL(I)=WI(I)
IF(MON.EQ.1.AND.NTB.EQ.3) WL(I)=AWL(I)
401 STAT(1,I)=.TRUE.
ITIM(I)=TIME(I)
IF(TABLE(7,JJ).EQ.0) GO TO 200
LL=LL+1
LTIME(LL)=I
LJJ(LL)=JJ
LII(LL)=II
200 CONTINUE
C ENCODE COMMENTS ON NATURE OF BACKGROUNDS
IC1=JNFO(10)/1000000
I=JNFO(10)-1000000*IC1
IC2=I/10000
I=I-10000*IC2
IC3=I/100
IC4=I-100*IC3
IC1=19
IF(LL.GT.0) IC1=18
JNFO(10)=(IC1*1000000)+(IC2*10000)+(IC3*100)+IC4
JS=0
IF(NSER.NE.NSERO)GO TO 39
WRITE(6,40)
WRITE(6,41)
40 FORMAT('1','NSER',3X,'LAN',2X,'NTB',1X,'TIME',3X,'TOT',4X,'BACK',2
2X,'STAT',2X,'LAN',3X,'ORB',1X,'TIME',1X,'NPT',2X,'FACTOR',2X,
3 'ORBIT')
41 FORMAT(7X,'SMART',31X,'GSFC')
39 WRITE(6,10) NSER,RLAN,NTB,TIME(1),TOT(1),BACK(1),(STAT(J,1),J=1,3)
1 ,RL1,KU1,KR,NPTS,FACT,KTOB
10 FORMAT(1X,I5,F7.2,1X,I1,1X,F4.0,2F8.1,1X,3L1,1X,F7.2,1X,2I3,1X,I4,
1 F9.2,I7)
38 IF(LL.EQ.0)GO TO 228
IF(TIME(1).NE.ATIME)GO TO 47
IF(NPTS1.EQ.NPTS)GO TO 48
47 WRITE(6,11)(LTIME(I),III(I),IJJ(I),I=1,LL)
11 FORMAT(10(I4,1X,'(',I2,',',I2,')'))
GO TO 49
48 WRITE(6,12) NSER1
12 FORMAT(4X,'ANOMALY EFFECTS AS FOR NSER=',I6)
49 LL=0
LL=0
228 CONTINUE
C STATUS FLAGS SET IN HEADER.
IF(MOD(JNFO(7)/268435456,2).EQ.0) JNFO(7)=JNFO(7)+268435456
IF(MOD(JNFO(8)/268435456,2).EQ.0) JNFO(8)=JNFO(8)+268435456
C NOW DO SOME VSHIFT LOGIC
225 IF(VSHIFT.EQ.0.0.OR.NTB.EQ.5.OR.NTB.EQ.6) GO TO 227
DO 226 KK=1,NPTS
226 WL(KK)=WL(KK)+(VSHIFT/SPDLHT)*WI(KK)
CALL QWLTIM(1,JNFO(4),WL(1),ITIM(1))
CALL QWLTIM(1,JNFO(5),WI(NPTS),ITIM(NPTS))
227 CALL QWLTIM(NPTS,IWLT,WL,ITIM)
CALL QCOUNT(NPTS,ICS,BACK,TOT,STAT,FLOAT(MULT))
IF(MON.EQ.0.OR.NTB.NE.3) GO TO 402
CALL QWLTIM(1,JNFO(4),AWL(1),ITIM(1))
CALL QWLTIM(1,JNFO(5),AWL(NPTS),ITIM(NPTS))
402 WRITE(60 ) STARN,(JNFO(KK),KK=1,12)
WRITE(60 ) NPTS,(IWLT(K),ICS(K),K=1,NPTS)
20 FORMAT(4(100A4))
ATIME=TIME(1)
NSER1=NSER
NPTS1=NPTS
IF(IFMON.EQ.1) MON=1
GO TO 300
1000 CONTINUE
WRITE(6,23) N
23 FORMAT('0*** BLEW IT IN SETUP. N=',I3,' ***')
STOP 777
1003 CONTINUE
WRITE(6,24)
24 FORMAT(3X,'STAR NUMBER NEEDED BUT NOT SPECIFIED')
STOP 888
1001 CONTINUE
WRITE(6,21) NSER
21 FORMAT('0*** END OF DATA SET. NSER=',I6,' ***')
301 STOP 100
1002 WRITE(6,22) NSER
22 FORMAT('0*** END OF BACKGROUND REWRITE REQUEST. NSER= ',I6,' ***')
STOP 100
305 WRITE(6,306) II,JJ
306 FORMAT('0INDICES FOR TABLE HAVE GOTTEN OUT OF RANGE. SUGGEST MAKIN
XG AN ABBREVIATED RUN WITH FULL OUTPUT. II=',I7,5X,'JJ=',I7)
STOP 999
END
Return to main paper.