9	PROGRAM XGFUNC	 !@@  Modify  XGFUNC to your utility name6C_TITLE  XGFUNC !@@ modify to whatever name you desireC_DESCRIPTION  :C @@The program  XGFUNC is a dummy main routine; it is theMC  XG database sample routine upon which application programs may be modeled.LC_HISTORY  89feb10  Hugh_H_Kieffer  Flagstaff 	!@@ put in date and your name
C_LIMITATIONSD	PARAMETER (ID1= 11)	!@@ Set to max number of columns to be allowed.A	PARAMETER (ID2= 600)	!@@ This must be 240:480:600 for  IR:MW:MI.6	PARAMETER (ID3= 20)	!Number of time ranges in a list.C_PAUSE$	INTEGER*2 IA(120, ID1), INDEX( ID2)F	CHARACTER*16 PROGNM /'XGFUNC:89feb10'/	!@@ your program name and date	EXTERNAL XGUSER:	MXNVAR = 12	! @@Set to max number of principal variables.<	INDEX(1) = 1	! @@ Transfer valid database flags to  XGINIT.C	INDEX(2) = 2    ! @@  Set INDEX(i) =0 if this routine is not valid<	INDEX(3) = 3    ! @@  for database i=1/2/3 == IRTM/MAWD/IRR=	CALL XGDATA (IA,ID1, INDEX,ID2, ID3, MXNVAR ,PROGNM, XGUSER)	STOP	END$	SUBROUTINE XGUSER (IQ,IA,NLINES,IR)CC_TITLE  Generalized database routine called by  XGDATA. (skeleton)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.C_DESCRIPTION  :C This subroutine is a generalized database routine calledNC by  XGDATA; it is the main code subroutine for  XGFUNC (application routine)HC This skeleton is to be modified by a programmer to perform whatever it C is that he or she wants to do.C_VARIABLES<	INCLUDE 'RAD$INC:XXCOM.INC/LIST'	!Uses:  ILIST,IDPRIM,IDSEC					  	!	,  J1,J2,DATIM. 						!Modifies:  none@	INCLUDE 'RAD$INC:XXGCOM.INC/LIST'	!Uses:  NVAR,INT,LUMPSQ,IUNIT						!	,  IDCON,TITLE. 						!Modifies:  NCOLP, ICOL<	INCLUDE 'RAD$INC:XXSCOM.INC/LIST'    	!Uses:  IFDSQ,MTITLE.						!Modifies:  none7	INCLUDE 'RAD$INC:XXDCOM.INC/LIST'	!Uses:  KSCALE,KDEF.						!Modifies:  none?C_CALLS  XGVDEF  !  USERINP  @O put in names of called routines%C_HISTORY  19@@mmmdd  PROGRAMMER_NAMEC_END	INTEGER*2 KPTIMEC	EQUIVALENCE (KPTIME,IDCON(4,1))	!  KPTIME is set negative if point 					! does not pass constraints#C next set of items used by  XGVDEF3	PARAMETER (NVDEF =30)		! @@ max # of all variables,	CHARACTER*5 SYM			! short name for variable1	CHARACTER*6 ULAB(NVDEF),TLAB	! label of variable2	CHARACTER*6 ISUN(NVDEF), TSUN	! units of variable?	CHARACTER*32 DESC(NVDEF),TDESC	! short description of variable<	INTEGER*2 ISS,IPS	! ISS = Storage scale, IPS = Print scale.	INTEGER*4 ICOD/	REAL*4 RVAR (NVDEF)		! used for physical units?	REAL*4 PSCALE(NVDEF)		! scaleing from stored to physical units1	INTEGER*4 IVAR (NVDEF)		! used for "print" units:	LOGICAL LFIRST2 		! first time this routine called at 200EC-0-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC Insert your specifications.EC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^,	IR=0 		! set return code to default success7	GO TO (100,200,300,400,500),IQ	! branch to proper stepOC IQ=1 =================================================================== IQ=1+C_____Initialization:  set up processing.  GC at this point, XGDATA has only called   XGINIT and STINPUT(1) & (2); CC  only the database, access code, and time range(s) have been set.?100	IFGSET=1	! @@ set to =0 if for some reason you want  XGDATA;C			!   to bypass XXGSET getting variables and constraints.	LFIRST2 = .TRUE.EC-1-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC Insert startup code6C@	NCOLP = x		! can predefine x columns by transfering?C@	ICOL(1) = col_1		!   the number of predefined columns  NCOLP5C@	...			!   and their positions in database into the(C@	ICOL(NCOLP) = col_n	!  COMMON/XXGCOM/EC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	RETURNOC IQ=2 =================================================================== IQ=2 C_____Sequence initialization.	 9200	IF (LFIRST2) THEN	! stuff to do before first sequence	  LFIRST2 = .FALSE.FC-2A-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvGC Insert any code to be done once after standard   XG input parameters C	are available>C@O  CALL USERINP (INT1, REAL1, CHAR1, CHAR2)	! get additional>C	input parameters via TAE . See RAD$SMP:USERINP.FOR skeleton.FC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^DC This loops through the ICOL array (principle variable columns) andEC converts the integer code to a two-byte symbol  SYM, a 6-byte labelIC  ULAB, a 6-byte unit  ISUN, a 32-byte description  DESC and fetches theFC storage units  ISS and print units  IPS.  The character descriptionsBC are used for text output, while the units are used to scale the 9C internally stored database variables to physical units.1C	IF (NVAR.GT.NVDEF) !!! should insert error test	  DO I = 1,NVAR	    ICOD = ICOL(I).	    CALL XGVDEF(2,SYM,ICOD,ISS,IPS,%REF(TLAB)      &		,%REF(TSUN),%REF(TDESC))	    ULAB(I)=TLAB	    ISUN(I)=TSUN	    DESC(I)=TDESC	    PSCALE(I)=KDEF(7,I)
	    ENDDOFC-2B-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv=C Insert user code to be done once, after column definitions.FC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	ENDIF<	IF (LUMPSQ.EQ.0) THEN	! if sequences are not to be combinedFC-2C-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv6C Insert any code to be done at start of each sequenceFC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	ENDIF	RETURNOC IQ=3 =================================================================== IQ=3KC-----Data processing of one row.  Constraints have been applied by XGDATA.
300	KGOOD = 0$C-----Loop on points (lines) in row.	DO 350 J=J1,J2C	  IF (IA(J,KPTIME).LT.0) GO TO 350 ! Skip point if it didn't pass >	  KGOOD = KGOOD+1	! count up points that did pass constraintsJC@O_optional_ Converting scaled integer variable to a real physical units.	IF (IUNIT.EQ.0)THEN	  DO K=1,NVAR	    IF(KDEF(7,K).NE.1)THEN)	      RVAR(K) = FLOAT(IA(J,K))/PSCALE(K)
	    ENDIF
	    ENDDO	ENDIFFC-3A-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,C Insert code for points passing constraintsEC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^GC@O_optional_ print out;  IUNIT= 0/1/2 => physical/storage/print units -	IF (IUNIT.EQ.0)THEN		! output physical units(	  WRITE (ILIST,9340) (RVAR(K),K=1,NVAR) 9340	  FORMAT (' ',21(1X,F10.3))0	ELSEIF (IUNIT.EQ.2) THEN	! output "print" units	  DO K=1,NVAR'	    IVAR(K) = FLOAT(IA(J,K))/KSCALE(K)
	    ENDDO(	  WRITE (ILIST,9341) (IVAR(K),K=1,NVAR)!	ELSE				! ouput in storage units(	  WRITE (ILIST,9341) (IA(J,K),K=1,NVAR)9341	  FORMAT (' ',21(1X,I10))	ENDIF350	CONTINUED	IF (KGOOD.LE.0) GOTO 390 ! no points in this row passed constraintsFC-3B-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv>C Insert code to further process items gathered from this row.FC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
390	RETURNPC IQ=4 =================================================================== IQ=4 400	CONTINUE		    FC-4-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv*C Insert end of sequence processing code. FC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	RETURNOC IQ=5 =================================================================== IQ=5500	CONTINUEFC-5-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!C Insert final code for this run.FC^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^	RETURN	END