	PROGRAM XPRINT		$C_TITLE  XPRINT  Dummy main routine.HC_DESCRIPTION  The program XPRINT.FOR is a dummy main routine; it is theKC the routine which initializes the database parameters for this version ofC (XGUSER). C_HISTORY  1983  R.Mehlman  UCLAC	   1985  H.Kieffer  Flagstaff"C	   87Feb19  R.Gurule  Flagstaff C_PAUSEA	PARAMETER (ID1= 21)	!Set to max number of columns to be allowed.=	PARAMETER (ID2= 600)	!This must be 240:480:600 for IR:MW:MI.6	PARAMETER (ID3= 20)	!Number of time ranges in a list.$	INTEGER*2 IA(120, ID1), INDEX( ID2)	CHARACTER*16 PROGNM	DATA PROGNM /'XPRINT:88MAY14'/	EXTERNAL PRUSER7	MXNVAR = 21	!Set to max number of principal variables.7	INDEX(1)=1	!Transfer valid database indexes to XGINIT.	INDEX(2)=2	INDEX(3)=3,	CALL XGDATA (IA,ID1, INDEX,ID2, ID3, MXNVAR     &	,PROGNM, PRUSER)	STOP	END$	SUBROUTINE PRUSER (IQ,IA,NLINES,IR)5C_TITLE  PRUSER function or variable display routine.C_ARGUMENTS<	INTEGER IQ		![I] Control variable, determines program flow.A	INTEGER*2 IA(NLINES,*)	![I] Return requested database variables.+	INTEGER NLINES		![I] Number of rows in IA.%	INTEGER IR		![O] Return status code.NC_DESCRIPTION  This subroutine is a specialize version of XGFUNC.  This moduleOC is modeled after XGUSER (part of XGFUNC).  This module extracts the database -C variables and formats them to a print file.2C_CALLS  COMMONS: XXCOM,XXGCOM,XXSCOM,XXDCOM,XXTAE!C_HISTORY  1983  R.Mehlman  UCLA. C	   1985  H.Kieffer  Flagstaff.#C	   87Feb19  R.Gurule  Flagstaff. C_VARSG	INCLUDE 'RAD$INC:XXCOM.INC/LIST'     !Uses:  ILIST,IDPRIM,IDSEC,J1,J2,F                                             !DATIM.  Modifies:  NONE.D	INCLUDE 'RAD$INC:XXGCOM.INC/LIST'    !Uses:  NVAR,INT,LUMPSQ,IUNIT,@                                             !ICOL,IDCON,TITLE. >                                             !Modifies:  NONE.;	INCLUDE 'RAD$INC:XXSCOM.INC/LIST'    !Uses:  IFDSQ,MTITLE.>                                             !Modifies:  NONE.:	INCLUDE 'RAD$INC:XXDCOM.INC/LIST'    !Uses:  KSCALE,KDEF.>                                             !Modifies:  NONE.C_END	CHARACTER*1 DUM,ICH	CHARACTER*5 SYM/        CHARACTER*6 ULAB(30),ISUN(30),TLAB,TSUN	CHARACTER*7 FMT(30)	CHARACTER*16 LABC	CHARACTER*160 FORM,FORM1	CHARACTER*32 DESC(30),TDESC	INTEGER*2 KPTIME,ISS,IPS 	INTEGER*4 ICOD,ISIZE(30),IS(30)	REAL*4 RVAR(21)
	DATA ISPA/0/ 	EQUIVALENCE (KPTIME,IDCON(4,1))C_____Insert specifications.	LOGICAL LMIDHD#	LOGICAL*1 LCC,LZERO/1H0/,LONE/1H1/	IR=0          	IF(NLPP.LT.60)NLPP=60	GO TO (100,200,300,400,500),IQ)C_____Initialization:  set up processing.100	CONTINUE
180	RETURN190	IR = -1	RETURN%C_____Sequence initialization.       200	CONTINUE4C_____Insert user code to follow column definitions.	IF( ISPA.EQ.0 )THENEC-----Initialize the variables needed to create a format at run-time.		  ISPA = 1	  FORM(1:2)='(X'	  IST=3
	  IEND=10		  IST1=3		  IND2=9	  FORM1(1:2)='(X'H!------Loop through all variables requested fetching the labels, units, ;!      despcription, format, and the title of the variable.	  DO I = 1,NVAR	    ICOD = ICOL(I)5       	    CALL XGVDEF(2,SYM,ICOD,ISS,IPS,%REF(TLAB)*     1     ,%REF(TSUN),%REF(TDESC),FMT(I))(!----Create a format statement as we go.;	    FORM(IST:IEND) = FMT(I)(1:4)//',1X,'	!Variable format. 	    IPT = INDEX(FMT(I),'.') - 1;	    WRITE(DUM,4001)FMT(I)(IPT:IPT)   !Internal read/write.@ 4001       FORMAT(A1)			     !Determine the width of the field.@            READ(DUM,4002)ISIZE(I)           !Minimum width = 6. 4002       FORMAT(I1)I!----We need to determine the width of each variable field to be printed.F!    If the isize(i) > 6, then add the number of columns over 6 to ourH!    spacing variable (normally 1).  e.g. If the field is f7.2 then have$!    a 2 space field between labels.	    IF(ISIZE(I).GT.6)THEN	      IS(I) = ISIZE(I)-6+1				    ELSE	      IS(I) = 1            ENDIF	    ENCODE(1,4003,ICH)IS(I) 4003       FORMAT(I1)+	    FORM1(IST1:IND2)='A6,'//ICH//'X,'	    D	    TYPE*, FORM1	    	   	    IST=IST+8	    IEND=IEND+8	    IST1=IST1+6	    IND2=IND2+6	    ULAB(I)=TLAB	    DESC(I)=TDESC	    ISUN(I)=TSUN          ENDDO6!-----Put a right parenthesis on the format statement.	  IEND=IEND-7	  FORM(IEND-4:IEND)=')    '	  IND2=IND2-6	  FORM1(IND2-4:IND2)=')    '	ENDIFD	TYPE*, ' FORMAT',FORM(1:IEND) D	TYPE*, ' FORMAT',FORM1(1:IND2)	LINE = NLPP
	IPAGE = 0	LMIDHD = .FALSE. C-----Sequences lumped together?C     Put LUMPSQ stuff here.7C     Insert code to be done at start of each sequence.       IF (LUMPSQ.EQ.0) GO TO 230.C-----Yes, keep same numbering.  Room on page?!      IF (LINE.GT.NLPP) GO TO 232(C-----Yes, set to print mid-page header.      LCC = LZERO      LINE = LINE+1      LMIDHD = .TRUE.      GO TO 240HC-----Seqs not lumped together, set to start on new page, new numbering. 230  IPAGE = 0 232  LCC = LONE      LINE = NLPP	+C-----Any sequence set to restart interval. 240  KINT = INT      IR = 0290   RETURNKC-----Data processing of one row.  Constraints have been applied by XGDATA.300   CONTINUE$C-----Loop on points (lines) in row.      DO 350 J=J1,J2:	IF (IA(J,KPTIME).LT.0) GO TO 350	!skip point if less than6                                                !zero. C-----No, middle-of-page header?        IF (LMIDHD) GO TO 320C-----No, page full?#        IF (LINE.LT.NLPP) GO TO 330+C-----Yes, increment page, initialize line.       IPAGE=IPAGE+1
       LINE=0PC Print header with column titles and optional units (new page or new sequence).JC Convert Title (K) into character variable so we only print what we want.*      ENCODE(16,319,LABC)(TITLE(K),K=1,4)	 319  FORMAT(4A4)A 320  WRITE (ILIST,9320) LCC,LABC(1:13) ,IDSUB,IDPRIM,IDSEC,IFDSQ     1 ,MTITLE,DATIM,IPAGE9 9320 FORMAT (A1,A13,' S/C ',I1,'  ORBIT ',I4,'  SEQ',I3,0     1 '  FDSQ',I10,2X,20A2,2X,5A4,'  PAGE',I3/)1      IF(IUNIT.EQ.0)THEN			!Print in Print units.-        WRITE (ILIST,FORM1)(ULAB(K),K=1,NVAR)-        WRITE (ILIST,FORM1)(ISUN(K),K=1,NVAR)      ELSE IF(IUNIT.EQ.1)THENE        WRITE (ILIST,9321)(ULAB(K),K=1,NVAR)	!Print in storage units.,        WRITE (ILIST,9321)(ISUN(K),K=1,NVAR)      ENDIF      WRITE (ILIST,9323) 9321 FORMAT (' ',21(5X,A6)) 9323 FORMAT (1X)      LINE=LINE+5      LMIDHD=.FALSE. 330  IF (IUNIT.NE.1)THEN>C-----Scale values, converting integer variable to a real one.            DO 335 K=1,NVAR          RVAR(K) = REAL(IA(J,K))!C------Scale to physical values.		 IF(KDEF(7,K).NE.1)THEN(           RVAR(K) = RVAR(K) / KDEF(7,K)         ENDIF  335  CONTINUEC------Print line.      ENDIF 340  LINE=LINE+1GC--Format for output, if iunit=0 output in physical units, else storage	C  units.      IF(IUNIT.EQ.0)THEN-        WRITE (ILIST,FORM) (RVAR(K),K=1,NVAR)!! 9340   FORMAT (' ',21(1X,F6.1))
      ELSE&	WRITE (ILIST,9341) (IA(J,K),K=1,NVAR) 9341	FORMAT (' ',21(1X,I10))      ENDIF 350  CONTINUEC-----End point (line) loop.      RETURN    MC-----End of sequence processing.                                            
              400  CONTINUE      RETURNC-----Final processing.                       500  CONTINUE      RETURN	      END                      