	PROGRAM XFIND		<C_TITLE  XFIND  Dummy main routine, sets up dimension sizes.NC_DESCRIPTION The program XFIND is a dummy main routine, initializing databaseC dimensions for FIND.9C_HISTORY 1985 HUGH H. KIEFFER, USGS FLAGSTAFF, AZ. 86001KC MODFIED 86DEC15, ROBERT L. GURULE, NIMS_VIMS DOCUMENTATION, PIN SOFTWARE.C_PAUSE	PARAMETER (ID1= 20)	=C ID1 = Number of input cols (principal + ick + constraints).7C     + Number of internal use cols (up to programmer).2C     + Number of output cols (0 in this version).	PARAMETER (ID2= 600)		PARAMETER (ID3= 20)	$	INTEGER*2 IA(120, ID1), INDEX( ID2)	EXTERNAL FINDUSER			CHARACTER*16 PN	DATA PN /'XFIND:88JUN02'/	INDEX(1)=1	INDEX(2)=2	INDEX(3)=36	MXNVAR = 11	!set to max number of principal variables9	CALL XGDATA (IA,ID1, INDEX,ID2,ID3, MXNVAR, PN,FINDUSER)	STOP	END&	SUBROUTINE FINDUSER (IQ,IA,NLINES,IR)	IMPLICIT INTEGER*2 (M)?C_TITLE FINDUSER Generalized database routine called by XGDATA.C_ARGUMENTSI	INTEGER IQ   	       ![I]Control code variable, determines program flow.B	INTEGER*2 IA(NLINES,*) ![I]Contains requested database variables.E	INTEGER NLINES	       ![I]Number of rows of data passed from xgdata.)	INTEGER IR	       ![O]Return error code.OC_DESCRIPTION  The subroutine FINDUSER is a specialized database routine calledKC by XGDATA.  This routine performs the averaging of the retrieved databaseGC variables.  This module checks the time variable to determine whetherGC the ick extracted has passed the constraints imposed by the user.  IfIC the time variable is positive then that ick's designated variable to be)C extracted is included in the averaging.HC_CALLS: XXGSET,XXGDEF,XXGCON   COMMONS: XXCOM,XXGCOM,XXSCOM,XXTAE,XXCOM/C_HISTORY  1985 H_KIEFFER  FLAGSTAFF, AZ. 860012C          1988 R_GURULE, USGS Flagstaff, AZ 86001C_VARS3	INCLUDE 'RAD$INC:XXCOM.INC'	!Uses:  ILIST,J1,J2.  9                                        !Modifies:  NONE.B	INCLUDE 'RAD$INC:XXSCOM.INC'    !Uses:  MNPSEQ,MSORB,MSEQ,MTITLE.2	                                !Modifies:  NONE..	INCLUDE 'RAD$INC:XXGCOM.INC'    !Uses:  NVAR.					!Modifies:  IFGSET,IDCON.5	INCLUDE 'RAD$INC:XXDCOM.INC'    !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*32 DESC(30),TDESC	CHARACTER*160 FORM,FORM1,FORM2	INTEGER*2 KPTIME,ISS,IPS(        INTEGER*4 KP(4),ISIZE(30),IS(30)	LOGICAL LSEQ1(	DIMENSION I4AVE(11),TEMP(11),PRIVAR(11)
	DATA ISPA/0/	IR=0	GO TO (100,200,300,400,500),IQ	!______ INITIALIZATION:  
 100	CONTINUE6	IFGSET = 1		!IFGSET = FLAG INDICATING TO CALL IFGSET.
	LSEQ1=.TRUE.O!------------------------------------------------------------------------------@!       RETURN: CODE 0 IF NORMAL, CODE 1 TO RESPECIFY DATA RANGE                  180    RETURN !_______Sequence initialization.200	IF (.NOT.LSEQ1) GO TO 220 6!_______Insert user code to follow column definitions.D       TYPE*, ' NVAR',NVAR	LSEQ1 = .FALSE.4C_____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&C-----Format the first line of output.D215	 FORMAT('0 ORB SEQ  TITLE',36X,'NPSEQ #_PASS',2X,<NVAR>(3A2,1X))(	  FORM(1:24)='(/X,2I4,2X,20A2,I6,I7,X,'		  IST=25
	  IEND=32?	  FORM1(1:42)='(''0 ORB SEQ  TITLE'',36X,''NPSEQ #_PASS'',1X,'
	  IST1=43
	  IND2=49H!------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,'	    	    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)=')    '	ENDIF;	FORM2(1:42) = '(''                                '',33X,'2	FORM2(43:IND2) = FORM1(43:IND2)		!The units line.;!---     Blank out first part of form1 on the second write.        IF(IUNIT.EQ.0) THEN'	 WRITE(ILIST,FORM1) (ULAB(K),K=1,NVAR)'	 WRITE(ILIST,FORM2) (ISUN(K),K=1,NVAR)	ELSE/	 WRITE(ILIST,216) ((KDEF(I,J),I=1,3),J=1,NVAR)<216	 FORMAT('0 ORB SEQ  TITLE',36X,'NPSEQ #_PASS',8(2X,3A2))	ENDIF	!-------All sequences:!220	CONTINUE                     9!_______Insert code to be done at start of each sequence. 	DO 225 I=1,NVAR225	  I4AVE(I)=0	  K4=0
290	RETURN                       E!-------Data processing of one row,... loop on points (lines) in row.300	CONTINUE      DO 350 J=J1,J2   		!_______Point to be skipped?	KPTIME = IDCON(4,1)!	IF (IA(J,KPTIME).LT.0) GO TO 350	DO 335 I=1,NVAR! 335	   I4AVE(I)=I4AVE(I)+IA(J,I)	   K4=K4+1 350  CONTINUEN!------End point (line) loop--------------------------------------------------      RETURN 400  CONTINUE				O!______Insert end of sequence code____________________________________________ 		      IF (K4.LT.1) RETURN      DO 425 I=1,NVAR	  PRIVAR(I) = I4AVE(I)6!----Always divide by KDEF(8,I) to get physical units.'!----Don't scale variables if scale = 1	 IF(IUNIT.EQ.0)THEN	   IF(KDEF(7,K).NE.1)THEN/ 	     PRIVAR(I) = PRIVAR(I) / (K4 * KDEF(7,I))	   ELSE'             PRIVAR(I) = PRIVAR(I) / K4		   ENDIF	 ELSE IF(IUNIT.EQ.1)THEN#           I4AVE(I) = I4AVE(I) / K4	 ENDIF425   CONTINUEH!--Piece of code controlling output for scaled units and physical units.>!  IF IUNIT =1 THEN scaled storage units, else physical units.            IF( IUNIT.EQ.0 )THEN5        WRITE(ILIST,FORM) MSORB,MSEQ,MTITLE,MNPSEQ,K4     1  ,(PRIVAR(I),I=1,NVAR),430     FORMAT(/X,2I4,2X,20A2,2I6,2X,11F7.1)      ELSE IF(IUNIT.EQ.1)THEN4        WRITE(ILIST,431) MSORB,MSEQ,MTITLE,MNPSEQ,K4     1  ,(I4AVE(I),I=1,NVAR))431     FORMAT(/X,2I4,2X,20A2,2I6,2X,8I8)      ENDIFO!------------------------------------------------------------------------------      RETURN 500  CONTINUE      RETURN	      END