?	SUBROUTINE XGVDEF (KODE, SYM,ICD, ISS,IPS,LABEL,UNIT,DESC,FMT)MC_Titl  XGVDEF provides definitions for  XG variables and user input symbols.C_Args2	INTEGER KODE		![I] controls mode. 1= symbol inputC				     2= variable_id input.0	CHARACTER*5 SYM		![B] User symbol for variable.=C		                     expected forms are  'AA' or  'AA-BB'..	INTEGER ICD	        ![B] Integer variable_id.?C		                        proper forms are: + = column number,LC                                                      -1 to -99 = function.1C				                -xxyy = difference of xx-yy.+	INTEGER*2   ISS	       ![O] Storage scale.)	INTEGER*2   IPS	       ![O] Print scale.<	INTEGER*2 LABEL(3)     ![O] 6-byte label for this variable.>	INTEGER*2 UNIT(3)      ![O] 6-byte physical unit of variable.I	INTEGER*2 DESC(16)     ![O] 32-byte description of the (first) variable.@	CHARACTER*7 FMT        ![O] 7 character printing format for the-                               !    variable.C_Vars!	INCLUDE 'RAD$INC:XXCOM.INC/LIST'#C 	Uses: IOUT,IDDB.  Modify: NONE. GC_File uses  LUN=11 only when first called for the variable table file.C_DescPC XGVDEF can translate between 2-character symbols and variable_id's, in either MC direction, and handles the "difference" variables of the original  XX code.JC Module XGVDEF also translates from variable_id to short labels for plot NC labeling.  Input argument errors, corresponding to undefined variables, are PC treated by returning benign values, and filling the text fields with "??????."FC Too many variables in the definition table yield a warning to  IOUT.1C_History 87oct18  Hugh_H_Kieffer  USGS_Flagstaff/C Derived from  RGurule's  USERTRANS of 87sep03BC Modified argument list to include a Format, used for user outputCBC Invoked whenever a need for character symbols, or variables are 9C needed.  See module STINPUT for examples on how to use.C_Calls  UPCASEC_End@	INTEGER IOD / 11 /	!Logical unit used temporarily on first call8	LOGICAL LFIRST/.TRUE./	!flag, first time routine calledA	PARAMETER (MVAR=27)	!Max number of variables in any  XG database)	INTEGER NN(MVAR)	!column id of variable.	CHARACTER*2 SS(MVAR)	!Symbols.(        CHARACTER*7 FM(MVAR)    !Formats%	INTEGER*2 IIS(MVAR)	!Storage scales.#	INTEGER*2 IIP(MVAR)	!Print scales.#	INTEGER*2 LL(3,MVAR)	!Short label.)        INTEGER*2 UU(3,MVAR)	!Short units$	INTEGER*2 DD(16,MVAR)	!Descriptions5	INTEGER IC3(3)		!Column numbers for the 3 databases.'	CHARACTER*5 SY		!to hold  SYM locally..	IER = 0			!Set returned error code to normal.:	IF (LFIRST) THEN	!Open variable file, read this database.-                                             A	OPEN (UNIT=IOD, FILE='RAD$TAB:VARTAB.INP',STATUS='OLD',READONLY);		ID = IDDB	!Transfer database number from common to local.:		NVAR = 0	!Number of variables defined for this database.;	DO IDUM= 1,999	!Now read the definitons for this database.0	  J = NVAR+1	!Read into next variable location.'	  IF (J.GT.MVAR) THEN	!Exceed storage.4		WRITE (IOUT,*) ' *** XGVDEF INTERNAL STORAGE FULL'			GOTO 18	      ENDIF/	  READ (IOD,11,END=18) IC3,SS(J),IIS(J),IIP(J)?     &,(LL(I,J),I=1,3), (UU(I,J),I=1,3), (DD(I,J),I=1,16),FM(J)<11	  FORMAT (3I3,X,A2,X, I6,X,I6,X, 3A2,X,3A2,X, 16A2,1X,A7)<	IF (IC3(ID).NE.0) THEN 		!Was defined for current database.1	  NVAR = NVAR+1		        !Keep the current line.E	  NN(NVAR) = IC3(ID)	        !And save the column (function) number.	ENDIF		ENDDO18		CLOSE (IOD)		LFIRST = .FALSE."D	WRITE (IOUT,*)'NVAR=',NVAR      
	    ENDIF8	IF (KODE.NE.1) GOTO 200	! branch to "variable_id input""	SY = SYM	! save as local variable4	CALL UPCASE (SY,5)	! force user symbol to uppercase)D	WRITE (IOUT,*)' SYM AFTER UPCASE = ',SY5C look for match to first 2 characters of user symbol
	DO I= 1,NVAR1	  IF (SY(1:2).EQ.SS(I)(1:2)) THEN	! have a match
		ICD = NN(I)		IPS = IIP(I) 		ISS = IIS(I)>	        FMT = FM(I)                     ! 7 character format.5		CALL A2AN (LL(1,I),LABEL,3)	! transfer 6-byte label		CALL A2AN (UU(1,I),UNIT,3)		CALL A2AN (DD(1,I),DESC,16)			GOTO 20	     ENDIF	  ENDDO	GOTO 88		! error: no match. 	C look for difference symbol20	NC = LEN(SYM)	IMIN = INDEX(SYM(1:NC),'-')9        IF (IMIN.EQ.0) GOTO 99	! no second variable, done
	DO I= 1,NVAR1	  IF (SY(4:5).EQ.SS(I)(1:2)) THEN	! have a match;		ICD = -(ICD*100 + NN(I))	! construct difference variable <		CALL A2AN (LL(1,I),UNIT,3)	! second label in place of unit		CALL A2AN (DD(1,I),DESC,16)<		CALL MVBYTE (1H-,1,1,UNIT(1),1)	!   and put in leading "-"			GOTO 99	     ENDIF	  ENDDOI	GOTO 89	! error: no match to 2nd symbol. leave  ICD as just first column9200	IF (ICD.LT.-100) THEN	! must have difference variable.		ICD1 = -(ICD/100)		! positive first variable3		ICD2 = -ICD -100*ICD1		! positive second variable8	    ELSE	! have either column_id or function (-1 to -9)		ICD1 = ICD
		ICD2 = 0	     ENDIF&D	WRITE (IOUT,*)'ICD1,ICD2=',ICD1,ICD2+	DO I=1,NVAR	! look for column_number match(		IF (ICD1.EQ.NN(I)) THEN	! have a match		  SYM(1:2)   = SS(I)(1:2)		  IPS = IIP(I)		  ISS = IIS(I)	          FMT = FM(I)7		  CALL A2AN (LL(1,I),LABEL,3)	! transfer 6-byte label		  CALL A2AN (UU(1,I),UNIT,3)		  CALL A2AN (DD(1,I),DESC,16)			GOTO 220			  ENDIF		ENDDOB	GOTO 88	! no match with any line in  VARTAB.INP for this database220	IF (ICD2.EQ.0) GOTO 99<	SYM(3:5) = '-??'	! indicate difference (??=not yet matched)	DO I=1,NVAR(		IF (ICD2.EQ.NN(I)) THEN	! have a match*			SYM(4:5) = SS(I)	! insert second symbol>		  CALL A2AN (LL(1,I),UNIT,3)	! second label in place of unit>		  CALL MVBYTE (1H-,1,1,UNIT(1),1) !   and put in leading "-"
			GOTO 99		    ENDIF		ENDDO+	GOTO 89	!  ERROR: no match to 2nd variableC error section: 88	IF (KODE.EQ.1) THEN%		ICD = -9876		! return benign column		    ELSE,		SYM = '?????'	! return "unknown" as symbol
	    ENDIF 	IPS = 1		! return safe integers	ISS = 11	CALL FILL (LABEL,3,2H??) ! put ?? in text fields	CALL FILL (DESC,16,2H??)89	CALL FILL (UNIT,3,2H??)	99	RETURN  	END