!        SUBROUTINE STINPUT (INXT)9C_TITLE  STINPUT is the user input subroutine for XGDATA.MC_ARGS  All Parameters are passed through common or through an argument list.D      INTEGER*4 INXT ![I] Determines which input is returned to the *                     !    calling routine.KC_DESCRIPTION  The subroutine STINPUT is an input routine for the variablesKC required in subroutine XGDATA.  This routine uses the TAE user interface.7C_CALLS  XRINTG  XRSTR  DECISTR  DECRSTR  XGVDEF LASTCH&C_COMMONS XXTAE, XXCOM, XXGCOM, PGMINCPC_HISTORY  Robert L. Gurule, 85-05-02 Original Version, USGS Flagstaff, AZ.86001FC REVISED 88-05-02 deleted entry LLIST, considered a confusion factor.C_VARIABLES7      INCLUDE 'RAD$INC:XXCOM.INC/LIST'    !Uses:  None.A                                          !Modifies:  IDDB,IDSUB.6      INCLUDE 'RAD$INC:XXTAE.INC/LIST'    !Uses: NONE.I                                          !Modifies: IACC,CHARTMP,IDSUB1,=                                          !LRANGE,NUML,INCON.7      INCLUDE 'RAD$INC:XXGCOM.INC/LIST'   !Uses: NCOLP.(					  !Modifies: NVAR,NCON,KSPOTS,NSPTSA                                          !INT,LUMPSQ,IUNIT,ICOL."      INCLUDE 'RAD$INC:TAEBAS.INC'C_END%      CHARACTER*25 QUINT(20),KHON(10)%      CHARACTER*30 COLCHAR(3),BUFKHON      CHARACTER*10 NAME      CHARACTER*7 FMT      CHARACTER*4 IDB            REAL*4 CON(3)*      INTEGER*2 LABEL(3),UNIT(3),DESC(16)       INTEGER*2 ISS,IPS,ITEP%      INTEGER*4 LENQ(20),IDUM(20),ICD"      INTEGER*4 KRANGE(6),LEN1(20)      INTEGER*4 LENCOL(3)&      DATA ISTDOUT/6/,IMODE/0/,ICNT/0/       GOTO(100,150,200,300),INXT4  100 CALL XZINIT(BLOCK,XPRDIM,ISTDOUT,XABORT,ISTAT)7      CALL XRSTR(BLOCK,'INST',1,IDB,NCHARS,ICNT,STATUS)&      IF (IDB(1:NCHARS).EQ.'IRTM')THEN          IDDB=1*      ELSE IF(IDB(1:NCHARS).EQ.'MAWD')THEN          IDDB=2)      ELSE IF(IDB(1:NCHARS).EQ.'IRR')THEN          IDDB=3      ENDIF      GOTO 999  150 CONTINUE!-----Extract the access mode.H        CALL XRSTR(BLOCK,'ACCESS',1,NAME,LEN,ICNT,ISTAT) !input Filename$        DECODE(6,5,NAME(1:6))CHARTMP   5    FORMAT(3A2)H!-------If a filename then equal to 'TS', else must optical disk access.8        IF(CHARTMP(1).EQ.'TS'.or.CHARTMP(1).EQ.'ts')THEN          IACC=-1	ELSE IF(LEN.EQ.0)THEN		  IACC=0	ELSE E          TYPE*, ' File access error, please enter filename of chunk'	ENDIF5!-----Enter the spacecraft range, using either range.!-----Actually fetch the range.8      CALL XRSTR(BLOCK,'RANGE',20,QUINT,LENQ,NUML,ISTAT)      DO 23 I=1,NUML			'        CALL DECISTR(QUINT(I),IDUM,KNT)          DO 36 K=1,6(             IF(K.EQ.1)IDSUB1(I)=IDUM(1)$             LRANGE(K,I) = IDUM(K+1)D	TYPE*, ' IDUM ',IDUM(K)8	     IF(K.EQ.2.AND.LRANGE(K,I).EQ.0)LRANGE(K,I)=IDUM(K)   36     CONTINUE   23 CONTINUE      GOTO 999  200 CONTINUE"!-----Fetch the sampling interval.5      CALL XRINTG(BLOCK,'SAMPLING',2,IDUM,LENS,ISTAT)      INT = IDUM(1)       LUMPSQ = IDUM(2)$!-----Fetch the input scaling units.3      CALL XRINTG(BLOCK, 'SCALE',1,IDUM,NINP,ISTAT)      IUNIT= IDUM(1)!-----Fetch the spot ranges.5      CALL XRINTG(BLOCK, 'SPOTS',7,KSPOTS,NSPI,ISTAT).!----Convert user input symbol into column id.;      CALL XRSTR(BLOCK, 'VAR',3,COLCHAR,LENCOL,NCIDS,ISTAT)      K = NCOLPL!-----For each character description passed by the user, fetch an equivalentM!     physical column integer identification, designating the location in theK!     database  (using XGVDEF).  This section of code extracts the variableK!     id's from the input string by looking for either commas or a sequenceL!     of characters ending with no comma.  When it finds either of the aboveI!     it extracts the character string, sends it to XGVDEF for conversion2!-----to a column id and places in the ICOL array.'!     NCIDS = Number of column's input.      DO 24 J=1,NCIDS1	BUFKHON(1:30) = '                              '        IST = 1        IND = 0      	IK = 0$!-------Delete any confusing spaces. 	DO I = 1,LENCOL(J)"	   IF(COLCHAR(J)(I:I).NE.' ')THEN	     IK = IK + 1&	     BUFKHON(IK:IK) = COLCHAR(J)(I:I)		   ENDIF	ENDDO
	IEND = IK		        DO I=1,IEND*          INR = INDEX(BUFKHON(1:IEND),',')   	  IF(INR .EQ. 0)IST=1=!------Search for a comma or the end of the character string..	  IF (BUFKHON(I:I).EQ.','.OR.(I.EQ.IEND))THEN             IND = I4             IF(BUFKHON(I:I).EQ.',')IND = I - 1	    !-----Convert to an integer id.E      CALL XGVDEF(1,BUFKHON(IST:IND),ICD,ISS,IPS,LABEL,UNIT,DESC,FMT)!!-----Check for an error. ICD = 1	     IF(ICD .EQ. -9876)THEN	        LSTR = IND - IST + 1"		WRITE(IOUT,2000)BUFKHON(IST:IND)#		WRITE(ILIST,2000)BUFKHON(IST:IND)< 2000           FORMAT(' Error in variable name ',A<LSTR>,/)4                IF(BUFKHON(I:I) .EQ. ',')IST = I + 1	        GOTO 60	     ENDIF             K = K + 1	     ITEP = ICD             ICOL(K) = ITEP      	     NVAR=K1             IF(BUFKHON(I:I) .EQ. ',')IST = I + 1	  ENDIF   60	ENDDO   24 CONTINUE!-----Fetch the constraints.7      CALL XRSTR(BLOCK, 'CON',10,KHON,LEN1,JCON,ISTAT)       NCON=0P!----Loop through the constraints, initializing bufkhon to blanks to start with.      DO 30 I=1,JCON1	BUFKHON(1:30) = '                              '@!-----Get rid of all spaces in whatever maybe in the khon array.K!     Perform constraint verification (is everything in the proper format?)?!     Find the last non (blank or tab) in the character string.D!     Place into temporary buffer bufkhon, with no extraneous blanks=!     IKNT is the number of characters in bufkhon (non-blank)      IKNT = 0      IF(LEN1(I).EQ.0)GOTO 301      LSTR = LASTCH(KHON(I)(1:LEN1(I)),1,LEN1(I))		IF(LSTR.LE.0)GOTO 30        DO J = 1, LSTR	   IF(KHON(I)(J:J).NE.' ')THEN	     IKNT = IKNT + 1.             BUFKHON(IKNT:IKNT) = KHON(I)(J:J)		   ENDIF	ENDDOD       TYPE*, BUFKHON(1:LSTR)%!-----Update the length of the string	LSTR = IKNT+!-----Search for first comma or last comma.(       	IST = INDEX(BUFKHON(1:LSTR),',')2        CALL DECRSTR (BUFKHON(IST+1:LSTR),CON,KNT)/D       TYPE*, (CON(J),J=1,KNT),BUFKHON(1:LSTR)@	IF(KNT.NE.2)WRITE(5,'('' Not proper number variables input'')')        IF(KNT.NE.2)GOTO 28	G        CALL XGVDEF(1,BUFKHON(1:IST-1),ICD,ISS,IPS,LABEL,UNIT,DESC,FMT);!------Convert from physical units to integer scaled units.K      	 XR = FLOAT(ISS)        !Input always in real physical units convert				!To storage units.(!------Increment the constraint counter.+!      Have a good constraint.             	                NCON = NCON + 1		       INCON(1,NCON) = ICD(       INCON(2,NCON) = IFIX(CON(1) * XR)(       INCON(3,NCON) = IFIX(CON(2) * XR)   30 CONTINUE!---- Normal termination.      RETURN!---- Abnormal termination.   28 CONTINUE1      STOP  ' Constraints not properly entered!!'  300 CONTINUE	5!-----Mode 4- stubbed out- not implemented currently.  999 RETURN	      END