	PROGRAM XDIR		BC_TITLE  XDIR  Dummy main routine initializes database dimensions.
C_DESCRIPTIONIC  The program XDIR is a dummy main routine,  It's primary function is toHC  dimension and initialize program variables for the selected database.CC_CALLS  XGDATA;C_HISTORY  82Dec07  R.Mehlman  UCLA  From  IRFUNC skeleton.$C 1/3/82 seq constraints added.  RMX6C 1/17/83 Modified  XXSCON, new constraint codes.  RMXDC Hugh_H_Kieffer 84FEB12 Combine IRTM and MAWD versions with XGDATA.FC  HHK 87jul26 7/26/84 Corrected Error = Branch on constraint request.*C  HHK 84dec27 New printer paging control.,C  HHK 85jul19 Use  GETN for user interface.FC  R.Gurule revised 3/11/86  To use the  TAE interface. PIN STANDARDS.7C  R.Gurule revised 1/23/88  changed XGUSER to DIRUSER.C_PAUSE@	PARAMETER (ID1= 1)	!Set to max number of columns to be allowed.>	PARAMETER (ID2= 1560)	!This is special for directory routine.5	PARAMETER (ID3=20)	!Number of time ranges in a list.	INCLUDE 'RAD$INC:TAEBAS.INC'$	INTEGER*2 IA(120, ID1), INDEX( ID2)	EXTERNAL DIRUSER	CHARACTER*16 PN2	DATA PN /'XDIR:88JUN21'/	!Must have : before date
	INDEX(1) = 1
	INDEX(2) = 2!	INDEX(3) = 0	!NOT valid for IRR.6	MXNVAR = 0	!Set to max number of principal variables.8	CALL XGDATA(IA,ID1, INDEX,ID2 ,ID3, MXNVAR, PN,DIRUSER)	STOP	END!	SUBROUTINE DIRUSER (IQ,IA,LS,IR)	IMPLICIT INTEGER*2 (M)KC_TITLE  DIRUSER  Acceses sequence and orbit header data for IRTM and MAWD.C_ARGUMENTSC	INTEGER IQ	   ![I] Control code variable, determines program flow.?	INTEGER*2 IA(LS,1) ![I] Contains requested database variables.0	INTEGER LS	   ![I] Number of columns requested.(	INTEGER IR	   ![I] Returns status code.NC_DESCRIPTION  The subroutine DIRUSER accesses sequence and orbit header data,IC performs constraining and aggregation of the data for the IRTM and MAWDDC databases.  This program will access the header information eitherGC from a chunk file or from an alternate condensed file containing only5C the Orbit and Sequence headers (TS1000, or TS2000).C'C  PRINT MODES:                        C9C    0  Sequence menu: orbit lines + 1 line per sequence.DC    1  Full sequence: orbit lines + all sequence info  (IRTM only). C   -1  Orbit: orbit lines only.C_CALLS  DIRINP  NEWPAG  XGVDEF+C_COMMONS XXCOM,XXGCOM,XXPCOM,XXSCOM,XXTAE.2C_HISTORY  R.Mehlman  See program -- XDIR heading.C_VARIABLESI      INCLUDE 'RAD$INC:XXCOM.INC/LIST'	!Uses:  IOUT, ILIST, IDDB, IDPRIM,@                                        !IDSEC.  Modifies: None.F      INCLUDE 'RAD$INC:XXGCOM.INC/LIST' !Uses:  IFGSET, IFGDEF, IDCON.1	                                !Modifies: None.@      INCLUDE 'RAD$INC:XXPCOM.INC/LIST' !Uses:  MNSEQ, MNPORB.  9                                        !Modifies:  NONE.L      INCLUDE 'RAD$INC:XXSCOM.INC/LIST' !Uses: MROW1, MROW2, MLINE1, MLINE2,L                                        !MNPSEQ, IFDSQ, IZMAG, MZLNG, MZCOL,M                                        !MJDQ1, MJDQ2, MTFPER, MXUFBQ, MVFXX,J                                        !MLON, MINT, MQAVE, MGEOM, MTITLE.8                                        !Modifies: NONE.@      INCLUDE 'RAD$INC:XXTAE.INC/LIST'  !Uses:  IACC, LOUT, LPP.8                                        !Modifies: NONE.C_PAUSEM      CHARACTER*5 SYM                   !Dummy two character string variable.      CHARACTER*6 LABEL,UNI      CHARACTER*7 FMT      CHARACTER*32 DESCC      REAL GEOM(2,11) , SCALE(11) /2*80.,800.,4*80.,1.,2*80.,1000./      INTEGER*4 ISS,IPS      INTEGER*2 IDUM(3,10):      INTEGER*2 ISCALE(12) /1,1,8,3*1,6*8/,LUNDB,NAMEDB(3)      DATA LPP /60/,NCON/0/
      IR=0$      GO TO (100,200,300,400,500),IQ!-----Initialization... 100  CONTINUE9      IFGSET = 0			!Turn off getting of general variables4      IFGDEF = 0			!In XGDATA. (doesn't call XXGSET)      IF (IDDB.NE.1) GOTO 130(!-----Prompt with variables used by DIR."      CALL DIRINP(NCON,IDUM,IMODE)18    CONTINUE      IF (NCON.EQ.0) GO TO 130;!-----Print, set up current constraints for XXSCON routine.3                                                   	WRITE (ILIST,930) D 930    FORMAT ('0  CONSTRAINTS: VAR                 MIN     MAX',/)	DO I=1,NCON	  ID1 = IDUM(1,I)	  ID2 = IDUM(2,I)	  ID3 = IDUM(3,I)
	  ICOD = ID1>          CALL XGVDEF(2,SYM,ICOD,ISS,IPS,%REF(LABEL),%REF(UNI)     1     ,%REF(DESC),FMT)5	  IF (IUNIT .EQ. 0)THEN			!Convert from print units.
	    XR = IPS'	  ELSE					!convert from storage units1	    XR = 1.0 / (ISS * IPS)			!To Physical units.	  ENDIF          RMIN = ID2 / XR          RMAX = ID3 / XR'	  WRITE(ILIST,932)DESC(1:20),RMIN,RMAX*  932     FORMAT(' ',13X,A20,F6.1,2X,F6.1)	ENDDO	!       Variables for DIR:8!       3=Phase angle  4=Range  7=Incid_ang  8=emiss_ang6!       9=Latitude  10=Longitude  11=Limb_ang  12=HourD!       1001=Solar_long.  1002=Solar_colat.  1003=DJUL  1004=Quality0!-----Decode constraints into numeric variables.G!     KVAR = KVAR - 1000, This is for the chunk directory entries, needB!     to correct, the only possible codes are in the list above.  !     see above comments.      DO 125 K=1,NCON 	   KVAR=IDUM(1,K)"	   IF(KVAR.LT.0)KVAR= 1000 - KVAR	   KSCALE=1)	   IF (KVAR.LT.1000) KSCALE=ISCALE(KVAR)	     IDCON(1,K)=KVAR!	     IDCON(2,K)=IDUM(2,K)*KSCALE! 125  IDCON(3,K)=IDUM(3,K)*KSCALE!-----Set up for printout. 130  ITMP = IMODE&!-----Initiate page control routine.        CALL NEWPAG(-LPP,ITMP)	        LINE=LPP
      KDORB=0
      KDSEQ=0      RETURNI!-----Sequence Initialization (file hdr sector in ia 1st time each file).$ 200  IF (IDPRIM.EQ.KDORB) GO TO 220      CALL NEWPAG (1,LINE)		#!-----New orbit: print orbit entry.      ZLNG=MZLNG/80.      ZCOL=MZCOL/80.      IF (IDDB.EQ.1) THENC       WRITE (ILIST,9210) IDSUB,IDPRIM,IZMAG,ZLNG,ZCOL,MNSEQ,MNPORB
      ELSEC       WRITE (ILIST,9211) IDSUB,IDPRIM,IZMAG,ZLNG,ZCOL,MNSEQ,MNPORB     . ,MTAPE,MFILE      ENDIFB 9210 FORMAT ('0S/C ',I1,'  ORBIT ',I4,'  ZMAG',I10,'  ZLON',F6.1,-     1 '  ZCOL',F6.1,'  NSEQ',I3,'  NPTS',I5)B 9211 FORMAT ('0S/C ',I1,'  ORBIT ',I4,'  ZMAG',I10,'  ZLON',F6.1,E     1 '  ZCOL',F6.1,'  NSEQ',I3,'  NPTS',I5,'  RAG TP/FL',I4,'/',I2)      LINE=LINE+2      IF (IMODE.LT.0)GOTO 218	IF (IDDB.EQ.1) THEN          WRITE (ILIST,9212)	ELSE          WRITE (ILIST,9213)	ENDIF        LINE=LINE+1        IF (IMODE.EQ.0)GOTO 218          WRITE (ILIST,9214)          LINE=LINE+3 218    KDORB=IDPRIM        KDSEQ=0!-----Menu and full seq modes.      IF(IDDB.EQ.1) THEN  220    IF(IMODE.LT.0) GO TO 280        CALL NEWPAG(2,LINE)			 230    DJUL=MJDQ1+MJDQ2/1000.        AMLON=MLON/80.        TPER=MTFPER/1000.        QUAL=MQAVE/10.?      WRITE (ILIST,9230) IDSEC,IFDSQ,MOET,DJUL,AMLON,TPER,QUAL,     1 MNPSEQ,MTITLE        LINE=LINE+1      IF (IMODE.EQ.0) GO TO 280!----Full sequence mode only.      XUFBQ = MXUFBQ/80.      DO 245 I=1,11       SCL=SCALE(I)       DO 245 J=1,2 245   GEOM(J,I)=MGEOM(J,I)/SCL6      WRITE (ILIST,9250) XUFBQ,MVFXX,MINT,MPROC,MTAPE,"     1  MROW1,MLINE1,MROW2,MLINE2,?     2  ((GEOM(J,I),I=1,7),MGEOM(J,8),(GEOM(J,I),I=9,11),J=1,2)        LINE=LINE+4
      ELSE:        WRITE (ILIST,9231) IDSEC,MPROC,IFDSQ,MNPSEQ,MTITLE        LINE=LINE+1      ENDIFF 9212 FORMAT ('  SEQ     FDSQ   ----OET---- JULDATE  MLON  TPER QUAL',%     1 ' NPTS  SRS ID   DESCRIPTION')D 9230 FORMAT (1X,I4,I11,I4,'/',I2,':',I2,':',I2,F7.1,F6.1,F6.2,F5.1,     1 I5,2X,20A2)B 9213 FORMAT ('  SEQ  OBS     FDSQ    NPTS  SRS ID   DESCRIPTION')C 9214 FORMAT ('         XUFBQ ------VFXX-------   INT  PROC  TAPE',"     1 '  ROW1/LINE1  ROW2/LINE2'/C     2        ' (MIN/MAX) LAT   LON  HOUR   INC  EMIS PHASE  LIMB',#     3 ' RANGE  CONE CLOCK  TPER'/)& 9231 FORMAT (1X,I4,I5,I11,I6,2X,20A2)* 9250 FORMAT (8X,F6.1,6I6,2(I6,'/',I3,2X)/-     1 2(8X,2F6.1,F6.2,4F6.1,I6,2F6.1,F6.2/))6!----Set to skip data processing, go to next sequence. 280  KDSEQ=IDSEC
 285  IR=2      RETURN,!-----Data processing of one row (not used). 300  CONTINUE      RETURN,!-----End of sequence processing (not used). 400  CONTINUE      RETURN           !-----Final processing. 500  CONTINUE      RETURN	      END!      SUBROUTINE NEWPAG (K,LINE)	GC_TITLE  NEWPAG  Writes header for a new page, and controls line count.C_ARGUMENTS6	INTEGER K	![I] Variable that determines program mode.*!			K = - (LINES/PAGE). Then Line = Imode.!	    		K = 1 new orbit.+!                       K = 2 new sequence.7	INTEGER LINE    ![O] Number of lines written thus far.HC_DESCRIPTION  The subroutine NEWPAG writes the header for a new page.  0C_HISTORY  R.Mehlman  See  XDIR program heading.C_END        CHARACTER*13 TITL(3)<	INCLUDE 'RAD$INC:XXCOM.INC'   !Uses: DATIM, Modifies: NONE.>        DATA TITL/'VIKING IRTM','VIKING IRR','MARINER 9 IRR'/		DATA IST/1/	IF (K.LT.1) THEN/	  LPP=-K		        !Initiate: K = -(LINES/PAGE)	  IPAGE=0			!"line" is imode.1	     IF (LINE.EQ.1) THEN	!Set max line to start:,		  LPP2=LPP-4	        !LPP2 = New sequence.*		  LPP1=LPP2-6	        !LPP1 = NEW orbit.	     ELSEIF (LINE.EQ.0) THEN		  LPP2=LPP-1	          LPP1=LPP2-3
	     ELSE		  LPP1=LPP-2	     ENDIF          RETURN	ELSE IF (K.EQ.1) THEN	  IF (LINE .LE. LPP1) RETURN	ELSE 	  IF (LINE .LE. LPP2) RETURN	ENDIF!-------Write page header.	IPAGE=IPAGE+1	IF(IST.EQ.1)THEN2	  WRITE (ILIST,9206) TITL(IDDB)(1:13),DATIM,IPAGE	ELSE2	  WRITE (ILIST,9205) TITL(IDDB)(1:13),DATIM,IPAGE	ENDIF	   :9205	FORMAT ('1',A13,' DIRECTORIES',22X,5A4,5X,'PAGE',I4/):9206	FORMAT ('0',A13,' DIRECTORIES',22X,5A4,5X,'PAGE',I4/)	LINE=2	RETURN	END