? 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