OC  PRCAT: READ SORTED IRTM CATALOG FILE, PRINT SELECTED ENTRIES W. CONSTRAINTS.IC	  FILE CREATED BY CONVCAT PROGRAM FROM TAPE GENERATED BY BLDCAT & SORT.C=C  BINS: 648 10 BY 10 DEGREE BINS IN MARINER 9 MARK IV SCHEME/C    PLUS 2 LANDING SITE BINS, 2 DEGREES SQUAREC;C  BIN FUNCTION: ((90-LAT)/10)*36 + LON/10 + 1  (FOR 1-648)C2C          180W               0               180E6C      90N --------------------------------------- 90N2C          /18 17        3 2 1 36 35        20 19/2C          /             ...37                   /2C          /                                     /2C        0 /                                     /2C          /                                     /2C          /                                     /2C          /                   648...            /6C      90S --------------------------------------- 90S2C          180W               0               180EC6C  LANDING SITE BINS ARE 649 FOR VL-1 AND 650 FOR VL-2CLC  NOTE: VO-1 SURVEY MISSION ENTRIES HAVE BEEN RENAMED TO THEIR CORRECT VO-1MC   NAMES.  TAPE VERSION OF FILE USES THEIR VO-2 PROCESSING NAMES:  B751-966.EC   THE CORRECT VO-1 ORBIT WAS OBTAINED FROM THE SRS ID OF THE TITLE.C4C  BIN ENTRY (40 WORDS)  DEGREES IN UNITS OF 1/80THSBC   1  BIN # (1-650)  SAME SCHEME AS MARINER 9, + 649=VL1, 650=VL22C   2  JULIAN DATE (INTEGER DAYS FROM JAN 0, 1950)HC   3  FRACTIONAL JULIAN DATE OF START OF SEQ IN BIN (TENTHS OF MINUTES)C   4  10000 * ORBITER + ORBIT/C   5  SEQUENCE (STARTING FROM 1 IN EACH ORBIT)C   6  # POINTS IN BIN;C   7  QUALITY CODE (AVERAGE OF QUAL BITS 11-13, IN TENTHS)C   8  FIRST ICK IN BINC   9  LAST ICK IN BINC  10  MINIMUM RANGEC  11  MAXIMUM RANGEC  12  MINIMUM EMISSION ANGLEC  13  MAXIMUM EMISSION ANGLEC  14  MINIMUM PHASE ANGLEC  15  MAXIMUM PHASE ANGLE:C  16  TIME FROM PERIAPSIS (SEQ START) (TENTHS OF MINUTES)C  17  LONGITUDE (SEQ START)C  18  HOUR (SEQ START)$C  19  SOLAR LONGITUDE (ORBIT START)%C  20  SOLAR COLATITUDE (ORBIT START)'C  21-40 SEQUENCE TITLE (40 CHARACTERS)CC  DISK FILE NAME:  IRTMCAT.DATHC  DISK FILE FORMAT:  FIXED-LENGTH 80-BYTE RECORDS, SPANNING VAX BLOCKS.LC  CATALOG SIZE:  275,920 RECORDS (ENTRIES) OR 22,073,600 BYTES OR 21.05 MB.<C		  THERE ARE SOME RECORDS OF ALL ZEROS AFTER THE LAST BIN.!C  INDEX FILE NAME:  IRTMCATX.DATGC  INDEX FILE FORMAT:  651 32-BIT INTEGERS (POINTERS TO FIRST RECORD OF8C			EACH BIN, PLUS POINTER TO FIRST FREE RECORD) CREATEDC			BY INDEXCAT PROGRAM.CC  PRCAT INPUT:,C   (1) OUTPUT MODE (0 TERMINAL  1 PRINTER),8C        [ LINES/PAGE, DUMP FLAG ] (NEG L/P: NO PG SKIP)>C   (2) CONSTRAINT TRIPLES (CODE,MIN,MAX)  (DEGREES IN TENTHS);C        CODES:  0 ALL DONE  2 JULIAN DATE FROM JAN 0, 1950AC                6 PTS/BIN   7 QUALITY ((TSDR QUALITY - 10) * 10)@C               10 RANGE (KM)  12 EMISSION ANGLE  14 PHASE ANGLEFC   (3) BIN RANGE & DELTA * OR * NEGATIVE # BINS & BIN LIST (UP TO 19)CC  OUTPUT (NORMAL MODE):@C   1 LINE PER SEQUENCE ENTRY PER BIN CONTAINING ORBITER, ORBIT,BC   SEQUENCE, ICK RANGE, # POINTS (SPOT-ICKS), DURATION (MINUTES),@C   AVERAGE QUALITY (QUAL-10 IN TENTHS), JULIAN DATE (DAYS SINCE@C   JAN 0, 1950), SOLAR LONGITUDE (DEGREES), TIME FROM PERIAPSIS6C   (MINUTES), MIN & MAX RANGE (KM), AVERAGE INCIDENCE?C   ANGLE, MIN & MAX EMISSION ANGLE, MIN & MAX PHASE ANGLE (ALLAC   IN TENTHS OF DEGREES), AVERAGE HOUR (TENTHS OF HOURS), SRS IDC   & TITLE OF SEQUENCE.C!C  CALLS DATIME,A2AN,COS,SIN,ACOSCOC  COGNIZANT PROGRAMMER:  R. MEHLMAN, UCLA/IGPP, L.A., CA 90024, (213) 825-24345C			  GRUMPY::RMEHLMAN, rmehlman@uclasp.igpp.ucla.eduCHC  * RMX 2/81 VERSION 3 AFTER DF'S VERSION WHICH DERIVES FROM RMX 6/7/783C  * VERSION 4 WITH OPTIONAL DISK FILE READ  3/2/81/C  * OPTION FOR NO PAGE SKIP ON NEW BIN  8/5/82@C  * VAX/VMS VERSION 2/25/83 * (DISK OPTION NOT YET IMPLEMENTED)*C  * SEQUENTIAL DISK VERSION, RMX 06/07/89=C     RUNNING ON CONVERTED CATALOG (CONVERTED BY PGM CONVCAT)HC  * DIRECT ACCESS VERSION, RMX 06/11/89 (using index file IRTMCATX.DAT)AC  * FILE NAMES CHANGED TO IRTMCAT.DAT, IRTMCATX.DAT, RMX 8/21/89C      PROGRAM PRCAT      IMPLICIT INTEGER*2 (J)>      COMMON /CENTRY/ JBIN,JD1,JD2,JDO,JSEQ,JPTS,JQ,JCK1,JCK2,<     1 JR1,JR2,JE1,JE2,JP1,JP2,JTFP,JLONQ,JHRQ,JLSUBS,JZCOL,     2 JTITLE(20)      LOGICAL*1 LDATIM(20)      REAL LAT1,LAT2,LON1,LON2      INTEGER*2 IBUF(40),LBIN.      INTEGER LIST(19),KODE(6),KMIN(6),KMAX(6)      INTEGER*4 INDX(650)(      CHARACTER*12 FNAME /'IRTMCAT.DAT'/)      CHARACTER*12 XNAME /'IRTMCATX.DAT'/?      INTEGER*2  NSC(2) /2HA ,2HB / , LZERO /2H0 /, LONE /2H1 /9      EQUIVALENCE (IB2,LIST(1)),(IBD,LIST(2)),(IBUF,JBIN)(      DATA LENTRY,IBMAX,MLIST,MCON,LMAXA)     1    /    40,  650,   19,   6,   56/!      DATA IFD,IFX,IIN,IOUT,ILIST"     1    /  1,  2,  5,   6,    7/C      DRC=3.14159/180.      CALL DATIME(LDATIM)C  REQUEST PARAMETERS 1    WRITE (IOUT,901)9 901  FORMAT (' ENTER OUTPUT MODE,[LINES/PAGE,DUMPFLAG]'/5     1 ' (3I7) / OUTPUT MODE: 0 TERMINAL  1 PRINTER')1      READ (IIN,902,ERR=1,END=65) LOUT,LMAXI,MODE 902  FORMAT (10I7)      LMAX=IABS(LMAXI)      IF (LMAX.EQ.0) LMAX=LMAXA      LSKIP=LONE!      IF (LMAXI.LT.0) LSKIP=LZERO      LDISK=.FALSE.      IF (LOUT.EQ.0) ILIST=IOUT.C  OPEN CATALOG FILE, OPEN AND READ INDEX FILEA      OPEN (IFD,FILE=FNAME,STATUS='OLD',ACCESS='DIRECT',READONLY)D      OPEN (IFX,FILE=XNAME,STATUS='OLD',FORM='UNFORMATTED',READONLY)      READ (IFX) INDXC  REQUEST CONSTRAINTS 9    NCON=1 10   WRITE (IOUT,910) NCONA 910  FORMAT (' ENTER CONSTRAINT TRIPLE # ',I1,' (CODE,MIN,MAX)',     1 ' (3I7) OR EOF TO EXIT'/D     2 '  CODES: 0 ALL DONE  2 JULIAN DATE  6 PTS/BIN  7 QUALITY  '/?     3 '        10 RANGE    12 EMISSION    14 PHASE  (.1 DEG)')C 11   READ (IIN,911,ERR=10,END=65) KODE(NCON),KMIN(NCON),KMAX(NCON) 911  FORMAT (3I7)#      IF (KODE(NCON).LE.0) GO TO 15      NCON=NCON+1       IF (NCON.LE.MCON) GO TO 10 15   NCON=NCON-1      IF (NCON.EQ.0) GO TO 20:      WRITE (ILIST,916) (KODE(I),KMIN(I),KMAX(I),I=1,NCON)> 916  FORMAT ('1PRCAT: CONSTRAINTS: CODE  MIN  MAX'/(20X,3I5))      DO 18 I=1,NCON!      IF (KODE(I).LT.12) GO TO 17      KMIN(I)=8*KMIN(I)      KMAX(I)=8*KMAX(I)% 17   IF (KMAX(I).EQ.0) KMAX(I)=32767 18   CONTINUEC  REQUEST BIN RANGE OR LIST 20   WRITE (IOUT,920)< 920  FORMAT (' (BIN RANGE & DELTA) OR (NEG # BINS & LIST)'/,     1 '  (20I4),  EOF FOR NEW CONSTRAINTS')*      READ (IIN,921,ERR=20,END=9) IB1,LIST 921  FORMAT (20I4)      JBIN=0C  DETERMINE BIN INPUT TYPE      IF (IB1) 22,20,21C  RANGE INPUT SETUP  21   IF (IB1.GT.IBMAX) GO TO 20      IF (IB2.LT.IB1) IB2=IB1!      IF (IB2.GT.IBMAX) IB2=IBMAX      IF (IBD.EQ.0) IBD=1      IB=IB1-IBD      GO TO 25C  LIST INPUT SETUP 22   NLIST=-IB1%      IF (NLIST.GT.MLIST) NLIST=MLIST
      LB=0% 25   WRITE (ILIST,925) MODE,IB1,LIST0 925  FORMAT ('0PRCAT: MODE ',I3,'  BINS ',20I5)
C  NEW BIN
 27   IPAGE=0      LINE=LMAX      IF (IB1.LT.0) GO TO 28C  RANGE INPUT: INCREMENT BIN      IB=IB+IBD      IF (IB.GT.IB2) GO TO 50      GO TO 29C  LIST INPUT: SET FOR NEXT BIN
 28   LB=LB+1      IF (LB.GT.NLIST) GO TO 50      IB=LIST(LB)*      IF (IB.LE.0.OR.IB.GT.IBMAX) GO TO 27'C  NEW BIN, GET START RECORD FROM INDEX 29   KREC=INDX(IB)-1C  READ NEXT RECORD/ENTRY 30   KREC=KREC+1!      READ (IFD'KREC,ERR=70) IBUF$C  INTO NEXT BIN, OR END OF CATALOG?+      IF (JBIN.GT.IB.OR.JBIN.EQ.0) GO TO 27C  IN CURRENT BIN 32   IF (NCON.EQ.0) GO TO 33C  APPLY CONSTRAINTS      DO 325 I=1,NCON      IKODE=KODE(I)      KTEST=IBUF(IKODE)$      IF (KTEST.GT.KMAX(I)) GO TO 48)      IF (IKODE.GE.8) KTEST=IBUF(IKODE+1)$      IF (KTEST.LT.KMIN(I)) GO TO 48 325  CONTINUEC  IN REQ BIN, PROCESS ENTRY 33   CONTINUE 34   IDSC=JDO/10000      IORB=JDO-10000*IDSC(C  PRINT LINE & PAGE HEADER IF NECESSARY 40   LINE=LINE+1       IF (LINE.LE.LMAX) GO TO 44C  PRINT PAGE HEADER      IPAGE=IPAGE+1      LINE=1-C  COMPUTE BIN LATITUDE AND LONGITUDE RANGES.      IF (IB.GE.649) GO TO 401      LAT=(IB-1)/36      LAT2=90-LAT*10      LAT1=LAT2-10      LON=MOD(IB,36)*10      LON2=LON      IF (LON.EQ.0) LON2=360      LON1=LON2-10      GO TO 403 401  IF (IB.EQ.650) GO TO 402      LAT1=21.3      LAT2=23.3      LON1=46.9      LON2=48.9      GO TO 403 402  LAT1=45.7      LAT2=47.7      LON1=224.7      LON2=226.7C  EXAMINE MODE 403  IF (MODE.EQ.0) GO TO 42C  HEADER FOR DUMP MODE' 41   WRITE (ILIST,941) IB,LDATIM,IPAGED 941  FORMAT ('1VIKING IRTM CATALOG: BIN ',I3,5X,20A1,5X,'PAGE ',I3/>     1 '0ORBIT SEQ --ICKS--- -JUL DATE- NPTS   Q ---RANGE---',=     2 ' -EMISSION ---PHASE---   TFP  LONQ   HRQ LSUBS ZCOL',     3 '  SRS ID & TITLE'/)      GO TO 44C  HEADER FOR NORMAL MODED 42   WRITE (ILIST,942) LSKIP,IB,LAT1,LAT2,LON1,LON2,LDATIM,IB,IPAGED 942  FORMAT(A1,'VIKING IRTM CATALOG: BIN ',I3,4X,'LATITUDE RANGE:',A     *F5.1,' TO ',F5.1,4X,'LONGITUDE RANGE:',F5.1,' TO ',F5.1,2X,     *20A1,' PAGE ',I3,'.',I2/C     *'0ORBIT SEQ ---ICKS-- NPTS DUR  Q  JD  L/S TFPE ---RANGE---',7     *'  INC ---EMIS-- --PHASE--HOUR  SRS ID & TITLE'/)C  DATA LINE: EXAMINE MODE 44   IF (MODE.EQ.0) GO TO 46C  PRINT DUMP LINEF 45   WRITE (ILIST,945) NSC(IDSC),IORB,JSEQ,JCK1,JCK2,JD1,JD2,JPTS,JQ,<     1 JR1,JR2,JE1,JE2,JP1,JP2,JTFP,JLONQ,JHRQ,JLSUBS,JZCOL,     2 (JTITLE(I),I=1,13)> 945  FORMAT (2X,A1,I4,I3,3I5,I6,I5,I4,2I6,2I5,6I6,I5,2X,13A2)      GO TO 48C#C  PERFORM NORMAL MODE COMPUTATIONS C  JULIAN DATE
  46  JDT=JD1E.C  DURATION, TIME FROM PERIAPSIS, QUALITY CODE      DUR=(JCK2-JCK1)*1.12/60.      JDUR=DUR+.5T.      JTFP=(JTFP/10.+(JCK1+JCK2)/120.*1.12)+.5      JQ=JQ-100HC  INCIDENCE ANGLE      DLONG1=JLONQ/80.      DHOUR1=JHRQ/800.%      DTIME=(JCK1+JCK2)/2.*1.12/3600. "      DELTL=(DHOUR1-12.+DTIME)*15.      DLSUN=DLONG1+DELTL)      IF (DLSUN.LT.0.)   DLSUN=DLSUN+360.-)      IF (DLSUN.GE.360.) DLSUN=DLSUN-360.       ZCOLAT=JZCOL/80.!      DLTLON=DLSUN-(LON1+LON2)/2. ,      IF (DLTLON.LT.0.)   DLTLON=DLTLON+360.,      IF (DLTLON.GE.360.) DLTLON=DLTLON-360.      DCOLAT=90.-(LAT1+LAT2)/2. 1C  CONVERT TO RADIANS AND COMPUTE INCIDENCE ANGLE       A=DCOLAT*DRC      B=ZCOLAT*DRC      C=DLTLON*DRC-      COSX=COS(A)*COS(B)+SIN(A)*SIN(B)*COS(C)       RINCX=ACOS(COSX)      DINCX=RINCX/DRCS      INC=DINCX*10.+.5C  EMISSION AND PHASE ANGLES      JE1=JE1/8.+.5I      JE2=JE2/8.+.5N      JP1=JP1/8.+.5       JP2=JP2/8.+.5S*      IF (JLSUBS.LT.0) JLSUBS=JLSUBS+28800      JLSUBS=JLSUBS/80.+.5!C  COMPUTE HOUR (MARS LOCAL TIME)E!      DLONG=DLONG1-(LON1+LON2)/2.O!      HOUR=DHOUR1+DTIME+DLONG/15.T$      IF (HOUR.LT.0.)  HOUR=HOUR+24.$      IF (HOUR.GE.24.) HOUR=HOUR-24.      IHR=HOUR*10.+.5-C  PRINT NORMAL MODE LINERG      WRITE (ILIST,946) NSC(IDSC),IORB,JSEQ,JCK1,JCK2,JPTS,JDUR,JQ,JDT,)8     *JLSUBS,JTFP,JR1,JR2,INC,JE1,JE2,JP1,JP2,IHR,JTITLE@ 946  FORMAT (2X,A1,I4,I3,3I5,I4,I3,I5,I4,I5,2I6,5I5,I4,2X,20A2)C  GO GET NEXT ENTRY 48   CONTINUE      GO TO 30CC  END OF REQUEST 50   WRITE (IOUT,950)  950  FORMAT ('0END OF REQUEST')      GO TO 20C  TERMINATION 60   CLOSE (IFD)
 65   STOPC  DISK READ ERROR 70   WRITE (IOUT,970) KREC/ 970  FORMAT (' DISK READ ERROR IN RECORD ',I5)      STOP 'I/O_ERROR'	      ENDCC&C  A2AN: MOVE OR SHIFT INTEGER*2 ARRAYC  CALL A2AN(IA,JA,N) WHERE<C   IA IS SOURCE ARRAY, JA IS DESTINATION ARRAY, N IS LENGTH"C   IA AND JA ARE INTEGER*2 ARRAYSC@ RMX 11/19/81   CALLS %LOC FN      SUBROUTINE A2AN(IA,JA,N)      INTEGER*2 IA(1),JA(1)C      IF (N.LE.0) GO TO 30C  WHICH END TO START LOOP?%      IF (%LOC(JA)-%LOC(IA)) 10,30,20
C  FORWARD 10   DO 15 I=1,N 15   JA(I)=IA(I)      GO TO 30C  BACKWARD
 20   NP1=N+1      DO 25 I=1,N
      J=NP1-I 25   JA(J)=IA(J) 30   RETURN	      ENDCCBC  DATIME: GET CURRENT DATE & TIME, RETURN AS 20 CHAR ASCII STRING1C  CALL DATIME(ISTR) WHERE ISTR IS 20 BYTE STRING:C  FORMAT: _DD-MMM-YY_HH:MM:SS_ (WHERE _ REPRESENTS BLANK)1C@ RMX 5/4/82  VAX/VMS VERSION   CALLS DATE, TIME      SUBROUTINE DATIME(ISTR)      LOGICAL*1 ISTR(20)C      ISTR(1)=' '      CALL DATE(ISTR(2))      ISTR(11)=' '      CALL TIME(ISTR(12))      ISTR(20)=' '      RETURN	      END