Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50365/mess3p.f10
There are no other files named mess3p.f10 in the archive.
C     MICHIGAN EXPERIMENTAL SIMULATION SUPERVISOR
C     VERSION 3-P
C     SEPTEMBER, 1975
C     ROBERT L. STOUT
C
C     MODIFIED SEPTEMBER 23, 1973 BY R. L. STOUT
C     REVISED SEPT. 1975
C
C
      IMPLICIT INTEGER*4 (A-H,P-Z), INTEGER*4 (O)
C
C------------------------------
C
C     SIMULATION VARIABLES
      INTEGER*4 VLIST(8,50),VNUM(50),GVNPTR(36),VSPTR(36),TYPE(36),
     1 KWR(2,36), KWLIST(8,120)
      INTEGER*4 SPECI(12,32),DSPECI(12),SPECF(12,32),DSPECF(12)
      INTEGER*4 KVAL(120),IVARS(12,32),DIVARS(12)
      REAL*4 FVARS(12,32), DFVARS(12)
      LOGICAL*4 ENTERD(36),FLAGS(12,32),DFLAGS(12)
!!      DATA KWR/72*0/, DIVARS/12*0/, DFVARS/12*0./, DSPECI/12*0/,
!!     1 DSPECF/12*0/, DFLAGS/12*.FALSE./
C
C
      COMMON /VARS/ IVARS, FVARS, SPECI, SPECF, FLAGS, ENTERD
C
      INTEGER*4 SI(12), SF(12)
      INTEGER*4 IV(12)
      REAL*4 FV(12)
      LOGICAL*4 FLGS(12)
C
      COMMON /VARS1/ IV,FV,SI,SF,FLGS
C
      INTEGER*4 CONDS
C     MAXCWS IS THE MAXIMUN NUMBER OF CONDITIONS WHICH CAN BE
C     APPLIED TO A GIVEN SUBJECT IN A WITHIN-SUBJECTS DESIGN FOR
C     ANY MODEL.  PARTICULAR MODELS MAY FURTHER LIMIT THE NUMBER OF
C     CONDITIONS TO A MINIMUM OF 1 (BETWEEN SUBJECTS DESIGNS ONLY)
C     BY GIVING APPROPRIATE VALUES TO THE GSC VARIABLE MAXCONDS
C     (INTERNAL FORTRAN NAME MAXC1).
!!      DATA MAXCWS/16/
      COMMON /CNDTNS/NC1,CONDS(16)
C
C     VARIABLES-CONSTANT-ACROSS-CONDITIONS-IN-WITHIN-SUBJECTS-DESIGNS
C     STUFF
C     NVCWSM IS THE MAXIMUM NUMBER OF SUCH VARIABLES
      INTEGER*4 VCWS(12)
!!      DATA NVCWS/0/, NVCWSM/12/, VCWS/12*0/
C
C------------------------------
C
C     SYSTEM PARAMETERS
C     LOOPT AND LECHO CONTROL ENABLING OF LOADER OPTIONS AND ECHOING
C     OF SIMULATION DATA INPUT.  LOOPT IS TURNED ON WHENEVER THE
C     >>LOAD COMMAND IS AVAILABLE, AND LECHO IS CONTROLLED BY THE
C     >>LECHO COMMAND.
      LOGICAL*4 LOOPT, LECHO
!!      DATA LOOPT/.FALSE./, LECHO/.FALSE./
C     NVNMAX IS THE MAXIMUM NUMBER OF VARIABLE NAMES AND ABBREVNS
C     NKWMAX IS THE MAXIMUM NUMBER OF KEYWORD NAMES AND ABBREVNS
C     NIVMAX IS THE MAXIMUM NUMBER OF INTEGER (NUMI,KWD,KI,IND) VARS
C     NFVMAX IS THE MAXIMUM NUMBER OF FLOATING POINT (NUMF,KF) VARS
C     NFGMAX IS THE MAXIMUM NUMBER OF LOGICAL (FLAG) VARS
C     MAXC IS THE MAXIMUM NUMBER OF CONDITIONS WHICH CAN BE DEFINED
C     NICMAX IS THE MAXIMUM NUMBER OF ILLEGAL CONDITIONS WHICH CAN BE
C	DEFINED
C     NTSMAX IS THE MAXIMUM NUMBER OF TESTS WHICH CONSTITUTE ILLEGAL
C	CONDITIONS
C     NRMAX IS THE MAXIMUM NUMBER OF NUMERIC RANGES USED IN RANGE
C	TESTS OR ILLEGAL CONDITIONS TESTS
!!      DATA NVNMAX/50/, NKWMAX/120/
!!      DATA NIVMAX/12/,NFVMAX/12/,NFGMAX/12/
!!      DATA NVARS/0/,NVN/0/,NKW/0/,NRUSED/0/,NTESTS/0/,NICOND/0/
!!      DATA MAXC/32/
!!      DATA NTSMAX/40/,NICMAX/25/,NRMAX/50/
C
C------------------------------
C
C     ODDS AND ENDS
      INTEGER*4 NVEC(8,3),KWVEC(8,3),NAME(8)
      REAL*4 FVEC(3)
      INTEGER*4 RCTR(36),RPTR(36),ICOND(2,25),CC(2), TESTS(3,40)
      REAL*4 RANGE(2,50), TCONS(40)
!!      DATA RCTR/36*0/, RPTR/36*0/, ICOND/50*0/, TCONS/40*0./
      REAL*4 FNUM,X,X1,X2
      INTEGER*4 RNO
      INTEGER*4 RC(5),RV(5)
!!      DATA RC/'^','-','=','>','<'/, RV/-1,-1,2,3,4/
!!      DATA BLANK/'  '/
      INTEGER*4 LINE
C
      COMMON /IO/IDEV1,IDEV2,IDEV3,IDEV4,ODEV1,ODEV2,ODEV3,ODEV4,
     1 LINE(80)
C
C     NOVNAM IS THE MAXIMUM NUMBER OF OUTPUT VARIABLE NAMES (2ND
C     DIMENSION OF OVNAM)
!!      DATA NOVNAM/6/
      INTEGER*4 SINK
      INTEGER*4 OVNAM(8,6)
      LOGICAL*4 COSTPT, DATOUT
      COMMON /IO1/NOV,SINK,OVNAM,COSTPT,DATOUT
C
      LOGICAL*4 WDES
      INTEGER*4 NPG(32),REPMES(8,3),CCH(2,16)
!!      DATA REPMES/'R','*',6*' ',  'W','*',6*' ',  'S','*',6*' '/
C
      LOGICAL*4 EOK,EXPTON,SHORT,VSHORT,VF(36),EPRNT,TV,PF
!!      DATA EXPTON/.FALSE./
!!      DATA SHORT/.FALSE./, VSHORT/.FALSE./
      INTEGER*4 IDLINE(80), EOSIND(4)
!!      DATA EOSIND/'@','E','N','D'/
C
      LOGICAL*4 LOK,EOF,T,F
!!      DATA T/.TRUE./, F/.FALSE./
C
C------------------------------
C
C     GENERAL SIMULATION CONTROL STUFF
!!      DATA NGSCV/6/, NGSCVN/12/, NGSCKW/0/, NGSCI/4/, NGSCF/0/,
!!     1 NGSCFG/2/
      INTEGER*4 GSCVNA(8,12),GSCVNM(12),GSCVNP(6),GSCVSP(6),GSCTYP(6),
     1 GSCKWR(1,1),GSCKWL(1,1),SIGSC(4,1),DSIGSC(4),SFGSC(1,1),
     2 DSFGSC(1)
      INTEGER*4 GSCKWV(1),IGSC(4,1),DIGSC(4)
      LOGICAL*4 GSCETD(6),FLGSC(2,1),DFLGSC(2),ECHOF
      REAL*4 FGSC(1,1), DFGSC(1)
C
      EQUIVALENCE (NDEF,IGSC(1,1)), (MAXC1,IGSC(2,1)), (NOVER,
     1 IGSC(3,1)), (NGRP,IGSC(4,1)), (ECHOF,FLGSC(2,1))
C     FOR EXPLANATION OF MAXC1, SEE DISCUSSION OF MAXCWS ABOVE
C     ECHOF CONTROLS ECHOING OF STUDENT INPUT ON THE PRINTER.
C     IF 'ECHO' APPEARS IN THE GSC STRING, ECHOF IS SET TO
C     .TRUE. (ECHOING ON), OTHERWISE ECHOF IS LEFT .FALSE..
C     ECHOF CAN ALSO BE SWITCHED ON OR OFF BY THE SUPERVISOR
C     COMMANDS >>ECHO AND >>NOECHO.
!!      DATA GSCVNA/'M','A','X','C','O','N','D','S','M','*','C','*',
!!     X4*' ','N','O','V','E','R',3*' ','N','*','V','*',4*' ','N','G',
!!     X'R','P',4*' ','N','*','G','*',4*' ','N','D','E','F',4*' ','N',
!!     X'*','D','*',4*' ','C','O','S','T','P','T',2*' ','C','*','T','*',
!!     X4*' ','E','C','H','O',4*' ','E','C','*',5*' '/
!!      DATA GSCVNM/1,1,2,2,3,3,4,4,5,5,6,6/
!!      DATA GSCVNP/1,3,5,7,9,11/
!!      DATA GSCVSP/2,3,4,1,1,2/
!!      DATA GSCTYP/1,1,1,1,7,7/
!!      DATA DIGSC/20,1,1000,1000/
!!      DATA DSIGSC/4*0/
!!      DATA DFLGSC/2*.FALSE./
C
C     LOADER NAME TABLES
      INTEGER*4 LNTBL1(8,11), LNVAL1(11), TYP(2,7)
!!      DATA NLN1/11/
!!      DATA LNTBL1/'I','N','T',5*' ','E','X','T',5*' ','N','U','M','I',
!!     X4*' ','N','U','M','F',4*' ','K','W','D',5*' ','K','I',6*' ','K',
!!     X'F',6*' ','I','N','D',5*' ','F','L','A','G',4*' ','T','*',6*' ',
!!     X'F','*',6*' '/
!!      DATA LNVAL1/-2,-1,1,2,3,4,5,6,7,100,101/
!!      DATA TYP/1,8,2,9,3,8,4,8,5,9,6,8,7,10/
C
C------------------------------
C
C     COMMAND DECODER STUFF
!!      DATA NCMDS/22/, NCNAM/0/, NCNMAX/44/, NRUNS/0/, TNGRPS/0/
      INTEGER*4 CMD(8),CMDTBL(8,44),CNUM(44)
      INTEGER*4 CMDRTN
C
C     CPFX CONTAINS THE ALLOWABLE SUPERVISOR COMMAND PREFIX CHARACTER
C     PAIRS, AND NCPFX IS THE NUMBER OF SUCH CHARACTER PAIRS.
C     TO CHANGE PREFIX CHARACTERS, ALTER THE DATA BELOW AND IN SUB-
C     ROUTINE INPUT
      INTEGER*4 CPFX(2,3)
!!      DATA NCPFX/3/, CPFX/'>','>','<','<','&','&'/
      LOGICAL*4 RPT, SAVBIN, SAVCRD
!!      DATA RPT/.FALSE./, SAVBIN/.FALSE./, SAVCRD/.FALSE./
C
C     UNDCMD CONTAINS THE NUMBERS OF 'UNDESIRABLE COMMANDS' WHICH ARE
C     DELETED WHEN THE SAVEBIN OR SAVECARD COMMAND IS GIVEN.  NCUND
C     IS THE NUMBER OF SUCH COMMANDS
      INTEGER*4 UNDCMD(4)
!!      DATA NCUND/4/, UNDCMD/6,7,17,18/
C
C     STATISTICS OPTIONS STUFF
      LOGICAL*4 STTIND, DSTIND(5),LT,AUTDEF
      COMMON /STAT1/ STTIND(5)
!!      DATA AUTDEF/.FALSE./, DSTIND/5*.FALSE./
!!      DATA NAMSTT/21/, NSTATS/5/
      INTEGER*4 STATNM(8,21), STATNO(21), GSONM(5)
C***************
C
C     MODEL NAME STUFF
C
      DOUBLE PRECISION MODNM1,MODNM2,MODNM3
      COMMON /DATANM/ MODNM1,MODNM2,MODNM3
C
C***************
C
C  ACTIVE DATA STATEMENTS
C
      DATA KWR/72*0/, DIVARS/12*0/, DFVARS/12*0./, DSPECI/12*0/,
     1 DSPECF/12*0/, DFLAGS/12*.FALSE./
      DATA MAXCWS/16/
      DATA NVCWS/0/, NVCWSM/12/, VCWS/12*0/
      DATA LOOPT/.FALSE./, LECHO/.FALSE./
      DATA NVNMAX/50/, NKWMAX/120/
      DATA NIVMAX/12/,NFVMAX/12/,NFGMAX/12/
      DATA NVARS/0/,NVN/0/,NKW/0/,NRUSED/0/,NTESTS/0/,NICOND/0/
      DATA MAXC/32/
      DATA NTSMAX/40/,NICMAX/25/,NRMAX/50/
      DATA RCTR/36*0/, RPTR/36*0/, ICOND/50*0/, TCONS/40*0./
      DATA RC/'^','-','=','>','<'/, RV/-1,-1,2,3,4/
      DATA BLANK/'  '/
      DATA NOVNAM/6/
      DATA REPMES/'R','*',6*' ',  'W','*',6*' ',  'S','*',6*' '/
      DATA EXPTON/.FALSE./
      DATA SHORT/.FALSE./, VSHORT/.FALSE./
      DATA EOSIND/'@','E','N','D'/
      DATA T/.TRUE./, F/.FALSE./
      DATA NGSCV/6/, NGSCVN/12/, NGSCKW/0/, NGSCI/4/, NGSCF/0/,
     1 NGSCFG/2/
      DATA GSCVNA/'M','A','X','C','O','N','D','S','M','*','C','*',
     X4*' ','N','O','V','E','R',3*' ','N','*','V','*',4*' ','N','G',
     X'R','P',4*' ','N','*','G','*',4*' ','N','D','E','F',4*' ','N',
     X'*','D','*',4*' ','C','O','S','T','P','T',2*' ','C','*','T','*',
     X4*' ','E','C','H','O',4*' ','E','C','*',5*' '/
      DATA GSCVNM/1,1,2,2,3,3,4,4,5,5,6,6/
      DATA GSCVNP/1,3,5,7,9,11/
      DATA GSCVSP/2,3,4,1,1,2/
      DATA GSCTYP/1,1,1,1,7,7/
      DATA DIGSC/20,1,1000,1000/
      DATA DSIGSC/4*0/
      DATA DFLGSC/2*.FALSE./
      DATA NLN1/11/
      DATA LNTBL1/'I','N','T',5*' ','E','X','T',5*' ','N','U','M','I',
     X4*' ','N','U','M','F',4*' ','K','W','D',5*' ','K','I',6*' ','K',
     X'F',6*' ','I','N','D',5*' ','F','L','A','G',4*' ','T','*',6*' ',
     X'F','*',6*' '/
      DATA LNVAL1/-2,-1,1,2,3,4,5,6,7,100,101/
      DATA TYP/1,8,2,9,3,8,4,8,5,9,6,8,7,10/
      DATA NCMDS/22/, NCNAM/0/, NCNMAX/44/, NRUNS/0/, TNGRPS/0/
      DATA NCPFX/3/, CPFX/'>','>','<','<','&','&'/
      DATA RPT/.FALSE./, SAVBIN/.FALSE./, SAVCRD/.FALSE./
      DATA NCUND/4/, UNDCMD/6,7,17,18/
      DATA AUTDEF/.FALSE./, DSTIND/5*.FALSE./
      DATA NAMSTT/21/, NSTATS/5/
      DATA STATNO/1,1,1,2,2,2,3,3,3,4,4,5,5,5,-1,-2,-3,-3,-3,-4,-4/
      DATA GSONM/1,4,7,10,12/
      DATA STATNM/'M','E','A','N',4*' ','M','*',6*' ','A','*','V','*',
     X4*' ','V','A','R','I','A','N','C','E','V','*',6*' ','S','*','D',
     X'*',4*' ','S','U','M','S','Q','R','S',' ','S','S',6*' ','S','*',
     X'Q','*',4*' ','C','O','V',5*' ','C','*','V','*',4*' ','C','O',
     X'R','R',4*' ','C','*','R','*',4*' ','R','*',6*' ','A','L','L',
     X5*' ','O','F','F',5*' ','A','U','T','O','D','E','F',' ','A','*',
     X'D','*',4*' ','A','*','F','*',4*' ','N','O','A','U','T','O','D',
     X'F','N','*','A','*',4*' '/
C
C**************************************************
C
C     SYSTEM INITIALIZATION
C  
C
C*****************************************************************
C
C	DEFINE LOCATION OF DATA FILES TO BE READ BY SUPERVISOR PROGRAM
C       24=INPUT DEVICE NUMBER;  MODNMI=ASCII MODEL NAME
C	DEFINED IN MODEL SUBROUTINE
C	4030=PROJECT NUMBER USED AT U MONTANA
C	11=PROGRAMMER NUMBER USED AT U MONTANA
C
	OPEN(UNIT=24,ACCESS='SEQIN',FILE=MODNM1,DIRECTORY='4030,11')
C
C	STUDENT INPUT
      IDEV1=5
C
C	SIMULATION COMMANDS AND VARIABLES:
C	READS SIMULATOR DATA DECK
      IDEV2=24
C
C	SIMULATION PARAMETERS (NUMBERS):
C	READS MODEL INITIALIZATION DECK(NOT USED FOR ALL MODELS)
      IDEV3=23
C
C	NOT USED
      IDEV4=0
C
C	STUDENT OUTPUT
C	BATCHK SETS ODEV1=5 IF A TERMINAL JOB; ODEV1=3 IF A BATCH JOB
C	BATCHK MAY BE SPECFIC TO THE MONTANA-SYSTEM 10
C	HOWEVER A SMALL AMOUNT OF REPROGRAMING IN THE MACRO PROGRAM
C	BATCH.MAC WILL CORRECT ANY DIFFICULTIES.
      CALL BATCHK(ODEV1)
C
C	DATA OUT
      ODEV2=21
C
C	XPRINT OUTPUT
      ODEV3=3
C
C	USED FOR SAVBIN AND SAVCARD FILES
      ODEV4=20
      SINK=ODEV1
      DATOUT=.FALSE.
C
C     PRINT SYSTEM ID
      WRITE(ODEV1,1000)
 1000 FORMAT(1H1,'MICHIGAN-MONTANA EXPERIMENTAL SIMULATION SUPERVISOR '/
     1 1X,'VERSION 3-P.3',5X,'SEPTEMBER, 1975'/
     2 1X,'WRITTEN BY ROBERT L STOUT',/
     3 1X,'ADAPTED TO THE DEC-SYSTEM-10 BY'
     4 /1X,'JAMES R ULLRICH AND ROY F TOUZEAU',
     5 /1H0)
C 
C------------------------------
C
C     READ IN LIST OF ALLOWABLE COMMANDS
 50   LPTR=100
 51   CALL NXT(LPTR,NAME,NUM,FNUM,F,IDEV2,&52,&51,&60,&51,&51,&59)
      GO TO 58
C
C     HAVE COMMAND NUMBER--READ COMMAND NAME AND ABBREVIATIONS
 52   IF(NUM.LE.0 .OR. NUM.GT.NCMDS)GO TO 58
 54   CALL NEXT(LPTR,NAME,BC,N,FNUM,T,&58,&54,&50)
      IF(NCNAM.GE.NCNMAX)GO TO 57
      NCNAM=NCNAM+1
      DO 53 I=1,8
 53   CMDTBL(I,NCNAM)=NAME(I)
      CNUM(NCNAM)=NUM
      IF(NUM.EQ.7)LOOPT=.TRUE.
      GO TO 54
C
C     COMMAND TABLE OVERFLOW
 57   WRITE(ODEV1,1001)
C
C     FATAL ERROR DURING CMDTBL INITIALIZATION
 58   WRITE(ODEV1,1002)
C     LIST RECORDS FROM IDEV2 UNTIL EOF, THEN DIE
 56   CALL INPUT(IDEV2,T,&59,&56)
      GO TO 56
 59   STOP '50'
C
C
 1001 FORMAT('0','CMDTBL OVERFLOW')
 1002 FORMAT('0','FATAL ERROR DURING CMDTBL INITIALIZATION')
C
C     JIGGLE RANDOM NOS. GENERATOR
 60   CALL JIGGLE
C
C     MODEL INITIALIZATION
      CALL MINIT(&10)
      GO TO 11
C     MODEL INITIALIZATION FAILURE
 10   STOP '10'
 11   CONTINUE
C
C
C**************************************************
C
C     THIS SECTION LOADS SIMULATION DATA
C
C     SEE IF SHOULD ALLOW OPERATOR TO SPECIFY LOADER OPTIONS BEFORE
C     STARTING TO LOAD DATA
      IF(.NOT.LOOPT)GO TO 100
C     PROMPT OPERATOR ABOUT LOADER OPTIONS
      WRITE(ODEV1,1101)
C
C     GO WAIT FOR COMMAND
      GO TO 490
C
C     LOAD COMMAND COMES HERE
 61   IF(.NOT.LOOPT)GO TO 502
      LOOPT=.FALSE.
C
 100  LOK=.TRUE.
      EOF=.FALSE.
C     
      IF(SAVBIN)OPEN(UNIT=ODEV4,ACCESS='SEQOUT',FILE=MODNM3,
     *    DIRECTORY='4030,11')
C     
C
C------------------------------
C
C     LIST MODEL IDENTIFICATION LINES
 101  LPTR=1
      CALL INPUT(IDEV2,F,&102,&105)
C
 105  IF(SAVBIN)WRITE(ODEV4)LINE
      IF(SAVCRD)WRITE(ODEV4,1402)LINE
C
C     SEARCH FOR EOS INDICATOR IN LINE
      CALL SFIND(EOSIND,LINE,4,80,LPTR,I,J,&104)
C
      IF(LECHO) JMAX=JMAXX(LINE,80)
      IF(LECHO) WRITE(ODEV1,1102) (LINE(III),III=1,JMAX)
C     END OF MODEL IDENT LINES
      GO TO 107
C
C     LIST LINE ON ODEV1
C
 104  JMAX=JMAXX(LINE,80)
      WRITE(ODEV1,1102) (LINE(III),III=1,JMAX)
      GO TO 101
C
C------------------------------
C
C     GET GENERAL SIMULATION CONTROL INFORMATION
 107  IF(LECHO)WRITE(ODEV1,1103)
      CALL INTERP(IDEV2,0,LECHO,NGSCV,NGSCVN,NGSCKW,NGSCI,NGSCF,NGSCFG,
     1 NERR,1,0,NX,GSCVNA,GSCVNM,GSCVNP,GSCVSP,GSCTYP,GSCETD,
     2 GSCKWR,GSCKWL,GSCKWV,IGSC,SIGSC,DIGSC,DSIGSC,FGSC,SFGSC,
     3 DFGSC,DSFGSC,FLGSC,DFLGSC,&102,&107)
      IF(NERR.EQ.0)GO TO 108
C     ERROR IN SIMULATION DATA
      LOK=.FALSE.
C
C     TEST GSC INFO FOR LEGALITY
 108  IF(MAXC1.LT.1 .OR. MAXC1.GT.MAXCWS)GO TO 189
      IF(NOVER.LT.1)GO TO 189
      IF(NGRP.LT.1)GO TO 189
      IF(NDEF.LT.1)GO TO 189
      COSTPT=FLGSC(1,1)
C
C------------------------------
C
C     READ VARIABLE DESCRIPTION STRING
      IF(LECHO)WRITE(ODEV1,1104)
      LPTR=1000
      PRN=101
C
C     LOOK FOR GENERIC NAME FOR VARIABLE
 109  CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&109,&200,
     1 &191,&191,&102)
C
C     ADD NEW VARIABLE TO LIST IF POSSIBLE
      IF(NVN.GE.NVNMAX)GO TO 194
      NVARS=NVARS+1
      NVN=NVN+1
      DO 110 I=1,8
 110  VLIST(I,NVN)=NAME(I)
      GVNPTR(NVARS)=NVN
      VNUM(NVN)=NVARS
      NVN1=NVN
C
C     NEXT THING MUST BE ABBREVNS OR STORAGE PTR
      PRN=102
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&111,&191,&191,&112,
     1 &191,&102)
      GO TO 192
C
C     ENTER LIST OF ABBREVIATIONS
 112  CALL ABBREV(VLIST,NVN,NVNMAX,IDEV2,LPTR,LECHO,&199)
      DO 103 I=NVN1,NVN
 103  VNUM(I)=NVARS
C     NEXT THING MUST BE STORAGE PTR
      PRN=103
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&111,&191,&191,&191,
     1 &191,&102)
      GO TO 192
C
C     HAVE VARIABLE STORAGE PTR
 111  VSPTR(NVARS)=NUM
C
C     EXT/INT AND TYPE SHOULD BE NEXT
      INTEXT=1
      ETYPE=0
      TYPE(NVARS)=0
      NKW1=0
 113  PRN=104
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&114,&191,&191,&115,
     1 &191,&102)
C
C     NAME MUST BE EXT/INT/TYPE/T OR F FOR FLAG VARIABLES
      PRN=105
      CALL NSRCH(NAME,LNTBL1,1,NLN1,J,&191)
      I=LNVAL1(J)
      IF(I.GT.10)GO TO 130
      IF(I.GT.0)GO TO 116
C
C     NEGATIVE MEANS INT/EXT
      INTEXT=-I
      IF(ETYPE.LE.0)GO TO 113
      TYPE(NVARS)=TYP(INTEXT,ETYPE)
      GO TO 113
C
C     TYPE VALUE
 116  ETYPE=I
      TYPE(NVARS)=TYP(INTEXT,ETYPE)
      GO TO 113
C
C
C     ENTER KWDS AND ABBREVNS
 115  PRN=106
      IF(TYPE(NVARS).LE.0)GO TO 187
      IF(ETYPE.LT.3 .OR. ETYPE.GT.6)GO TO 191
C
      KWR(1,NVARS)=NKW+1
      KWR(2,NVARS)=NKW+1
C
C     LOOK FOR KWD
 120  PRN=107
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&191,&191,&191,
     1 &121,&102)
C
C     STORE NEW KWD UNLESS NO ROOM
      NKW1=NKW1+1
      IF(NKW.GE.NKWMAX)GO TO 195
      NKW=NKW+1
      KWR(2,NVARS)=NKW
      DO 122 I=1,8
 122  KWLIST(I,NKW)=NAME(I)
      NKW2=NKW
C
C     NEXT SHOULD COME ABBREVNS/NUMERIC VALUE FOR KWD
      PRN=108
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&123,&191,&191,&124,
     1 &191,&102)
      GO TO 192
C
C     ENTER KWD ABBREVIATIONS
 124  PRN=109
      CALL ABBREV(KWLIST,NKW,NKWMAX,IDEV2,LPTR,LECHO,&199)
      KWR(2,NVARS)=NKW
C     GET KWD VALUE
      PRN=110
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&123,&191,&191,&191,
     1 &191,&102)
      GO TO 192
C
C     ENTER KWD VALUE
 123  I2=KWR(2,NVARS)
      DO 125 I=NKW2,I2
 125  KVAL(I)=NUM
      GO TO 120
C
C     HAVE WHAT APPEARS TO BE DEFAULT VALUE FOR FLAG VARIABLE
 130  IF(ETYPE.NE.7)GO TO 192
      I1=VSPTR(NVARS)
      IF(I1.LE.0 .OR. I1.GT.NFGMAX)GO TO 196
      DFLAGS(I1)=.FALSE.
      IF(I.EQ.100)DFLAGS(I1)=.TRUE.
      GO TO 109
C
C     LOOK FOR DEFAULT VALUE
 121  PRN=111
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&114,&191,&191,&191,
     1 &191,&102)
C
C     HAVE KWD FOR DEFAULT VALUE
      IF(ETYPE.LT.3 .OR. ETYPE.GT.6)GO TO 192
      IF(NKW1.LT.1)GO TO 197
      I1=KWR(1,NVARS)
      I2=KWR(2,NVARS)
      CALL NSRCH(NAME,KWLIST,I1,I2,K,&198)
      NUM=KVAL(K)
C
C     BRANCH ON TYPE
      GO TO (191,191,131,132,133,131,191),ETYPE
C
C     BRANCH ON TYPE
 114  GO TO (131,134,131,131,134,131,191),ETYPE
C
C     STORE DEFAULT FOR INTEGER VARIABLE
 131  I1=NUM
      I2=0
      GO TO 136
C
C     STORE 'SPECIAL' DEFAULT FOR INTEGER VARIABLE
 132  I1=0
      I2=NUM
 136  I=VSPTR(NVARS)
      IF(I.LE.0 .OR. I.GT.NIVMAX)GO TO 196
      DIVARS(I)=I1
      DSPECI(I)=I2
      GO TO 135
C
C     STORE DEFAULT FOR FP VARIABLE
 134  I2=0
      GO TO 137
C
C     STORE 'SPECIAL' DEFAULT FOR FP VARIABLE
 133  FNUM=0.
      I2=NUM
 137  I=VSPTR(NVARS)
      IF(I.LE.0 .OR. I.GT.NFVMAX)GO TO 196
      DFVARS(I)=FNUM
      DSPECF(I)=I2
C
C     MAKE SURE KWDED VARIABLES HAVE KWDS ATTACHED
 135  IF(ETYPE.GE.3 .AND. ETYPE.LE.6 .AND. NKW1.LE.0)GO TO 197
C
C
C     GET LEGAL RANGES, IF ANY
      RCTR(NVARS)=0
      RPTR(NVARS)=NRUSED+1
C
 140  PRN=112
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&109,&200,&141,
     1 &191,&102)
      GO TO 192
C
C     LEFT PAREN SIGNALS BEGINNING OF RANGE
 141  PRN=113
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&142,&191,&191,&191,
     1 &191,&102)
      GO TO 192
C
C     HAVE 1ST ELEMENT OF RANGE
 142  IF(NRUSED.GE.NRMAX)GO TO 188
      NRUSED=NRUSED+1
      RANGE(1,NRUSED)=FNUM
      PRN=114
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&143,&191,&191,&191,
     1 &191,&102)
      GO TO 192
C
C     LAST PART OF RANGE
 143  RANGE(2,NRUSED)=FNUM
      RCTR(NVARS)=RCTR(NVARS)+1
C     GET FINAL RT PAREN
      PRN=115
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&191,&191,&191,
     1	&140,&102)
      GO TO 192
C
C------------------------------
C
C     THIS SECTION FIELDS FATAL ERRORS IN LOADING SIM DATA
C
C     NUMBER IN INAPPROPRIATE PLACE
 190  WRITE(ODEV1,1105)FNUM
      GO TO 199
C
C     SOMETHING IS VAGUELY WRONE
 191  WRITE(ODEV1,1106)
      GO TO 199
C
C     UNEXPECTED EOF
 102  EOF=.TRUE.
      GO TO 199
C
C     NAME IN INAPPROPRIATE PLACE
 192  WRITE(ODEV1,1107)NAME
      GO TO 199
C
C     VARIABLE NAME LIST OVERFLOW
 194  WRITE(ODEV1,1111)NAME,NVN,NVNMAX
      GO TO 199
C
C     KEYWORD LIST OVERFLOW
 195  WRITE(ODEV1,1112)NAME,NKW,NKWMAX
      GO TO 199
C
C     BAD VAR STG PTR
 196  WRITE(ODEV1,1113)NVARS,ETYPE,VSPTR(NVARS)
      GO TO 199
C
C     NO KWDS SPECIFIED FOR KWDED VARIABLE
 197  WRITE(ODEV1,1114)NVARS
      GO TO 199
C
C     INVALID KWD DEFAULT
 198  WRITE(ODEV1,1115)NAME,NVARS
C
C     MOST SIM LDR ERRORS WIND UP HERE EVENTUALLY
 199  WRITE(ODEV1,1108)PRN,LPTR,LINE
      LOK=.FALSE.
      IF(EOF)GO TO 491
      WRITE(ODEV1,1109)IDEV2
      CALL INPUT(IDEV2,T,&491,&491)
      GO TO 491
C
C     BAD VALUE FOR GSC VARIABLE
 189  WRITE(ODEV1,1118)
      GO TO 199
C
C     RANGE TABLE OVERFLOW
 188  WRITE(ODEV1,1117)NVARS,NRUSED
      GO TO 199
C
C     NO TYPE GIVEN FOR VARIABLE
 187  WRITE(ODEV1,1119)NVARS
      GO TO 199
C
C------------------------------
C
 1101 FORMAT(1H0,'ENTER LOADER OPTIONS, THEN ''>>LOAD'' ')
 1102 FORMAT(1X,80A1)
 1103 FORMAT(1H0,4X,'GSC INFO:')
 1104 FORMAT(1H0,4X,'VD STRING:')
 1105 FORMAT(' INAPPROPRIATE NUMBER:',G14.5)
 1106 FORMAT(' VAGUE ERROR')
 1107 FORMAT(' INAPPROPRIATE NAME: ',8A1)
 1108 FORMAT(' PRN=',I5,'  LPTR=',I4/' LAST LINE READ WAS:'/1X,80A1)
 1109 FORMAT(' NEXT LINE ON DEVICE',I3)
 1111 FORMAT(' VAR NAME LIST OVERFLOW; NAME: ',8A1,' NVN=',I5,
     1 ' NVNMAX=',I5)
 1112 FORMAT(' KWD LIST OVERFLOW; NAME: ',8A1,' NKW=',I5,' NKWMAX=',
     1 I5)
 1113 FORMAT(' BAD STORAGE PTR FOR VARIABLE',I4,' ETYPE=',I2,
     1 ' PTR=',I5)
 1114 FORMAT(' NO KWDS FOR VARIABLE',I5)
 1115 FORMAT(' INVALID KWD DEFAULT: ' ,8A1,' VAR.',I4)
 1117 FORMAT(' RANGE TABLE OVERFLOW; VAR.',I4,' NRUSED=',I5)
 1118 FORMAT(' BAD GSC VAR. VALUE')
 1119 FORMAT(' NO TYPE FOR VAR.',I4)
C
C------------------------------
C
C     READ ILLEGAL VARIABLE COMBINATIONS STRING
 200  IF(LECHO)WRITE(ODEV1,1200)
      LPTR=1000
C
C     LOOK FOR ILLEGAL CONDITION SUBSTRING
 202  ASSIGN 201 TO I220
      GO TO 220
C
C     HAVE 1ST TEST FOR NEW ILLEGAL CONDITION
 201  IF(NICOND.GE.NICMAX)GO TO 297
      NICOND=NICOND+1
      ICOND(1,NICOND)=NTESTS
      ICOND(2,NICOND)=NTESTS
C
C     READ SUBSEQUENT TESTS TO FINISH IC DEFINITION
 204  ASSIGN 203 TO I220
      GO TO 220
 203  ICOND(2,NICOND)=NTESTS
      GO TO 204
C
C------------------------------
C
C     THIS SECTION READS IN A SINGLE TEST
 220  PRN=220
C
C     LOOK FOR NAME OF VARIABLE 1 OF TEST
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&202,&250,&191,
     1 &191,&102)
C
C     SHOULD HAVE VARIABLE NAME
      CALL NSRCH(NAME,VLIST,1,NVN,K,&192)
C
C     HAVE START OF TEST
      IF(NTESTS.GE.NTSMAX)GO TO 299
      NTESTS=NTESTS+1
      NV=VNUM(K)
      TESTS(1,NTESTS)=NV
C
C     NEXT THING SHOULD BE TEST RELN CHARACTERS
      NC=0
      RNO=1
 221  PRN=221
      CALL NEXT(LPTR,NAME,BC,NUM,FNUM,F,&190,&222,&224)
      GO TO 192
C
C     CHECK BC
 222  CALL ATQ(BC,LPTR,&191)
      NC=NC+1
      DO 223 I=1,5
      IF(BC.NE.RC(I))GO TO 223
      RNO=RNO*RV(I)
 223  CONTINUE
      IF(IABS(RNO).NE.1)GO TO 225
      IF(NC.GE.2)GO TO 191
      GO TO 221
C
C     READ NEXT LINE
 224  LPTR=1
      CALL INPUT(IDEV2,LECHO,&102,&221)
      GO TO 221
C
C     HAVE TEST RELN--SEE WHAT'S NEXT
 225  TESTS(2,NTESTS)=RNO
      PRN=222
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&226,&191,&191,&227,
     1 &191,&102)
C
C     HAVE VARIABLE NAME
      CALL NSRCH(NAME,VLIST,1,NVN,K,&192)
      TESTS(3,NTESTS)=VNUM(K)
      GO TO 229
C
C     HAVE CONSTANT
 226  TESTS(3,NTESTS)=0
      TCONS(NTESTS)=FNUM
      GO TO 229
C
C     HAVE RANGE COMING UP
 227  PRN=223
      IF(IABS(RNO).NE.2)GO TO 191
      TESTS(2,NTESTS)=TESTS(2,NTESTS)/2
      IF(NRUSED.GE.NRMAX)GO TO 188
      NRUSED=NRUSED+1
C
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&232,&191,&191,&191,
     1	&191,&102)
C
C     HAVE (HOPEFULLY) A KWD
      I=TYPE(NV)
      GO TO (192,192,230,231,231,230,192,230,231,192),I
C
C     TEST IS TO BE MADE ONLY ON 'SPECIAL' VALUE
 231  TESTS(1,NTESTS)=-TESTS(1,NTESTS)
C
C     GET VALUE FOR KWD
 230  I1=KWR(1,NV)
      I2=KWR(2,NV)
      CALL NSRCH(NAME,KWLIST,I1,I2,K,&192)
      FNUM=KVAL(K)
C
 232  RANGE(1,NRUSED)=FNUM
C
C     GET 2ND PART OF RANGE (IF ANY)
      PRN=224
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&233,&191,&191,&191,
     1	&234,&102)
C
C     KWD
      I=TYPE(NV)
      GO TO (192,192,235,235,235,235,192,235,235,192),I
 235  I1=KWR(1,NV)
      I2=KWR(2,NV)
      CALL NSRCH(NAME,KWLIST,I1,I2,K,&192)
      FNUM=KVAL(K)
C
 233  RANGE(2,NRUSED)=FNUM
      TESTS(3,NTESTS)=NRUSED
C
C     MAKE SURE VALUES ORDERED CORRECTLY
      IF(RANGE(1,NRUSED).LE.RANGE(2,NRUSED))GO TO 236
      RANGE(2,NRUSED)=RANGE(1,NRUSED)
      RANGE(1,NRUSED)=FNUM
C
C     GET RT PAREN
 236  CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&191,&191,&191,
     1	&229,&102)
      GO TO 192
C
C     'RANGE' CONSISTS OF ONLY 1 VALUE
 234  TCONS(NTESTS)=RANGE(1,NRUSED)
      NRUSED=NRUSED-1
      TESTS(2,NTESTS)=2*TESTS(2,NTESTS)
      TESTS(3,NTESTS)=0
C
C     RETURN
 229  GO TO I220,(201,203)
C
C------------------------------
C
C     READ LIST OF VARIABLES WHICH MUST BE CONSTANT ACROSS ALL COND-
C     ITIONS APPLIED TO A GIVEN SUBJECT IN A WITHIN-SUBJECTS DESIGN
C     (LIKE SEX OF SUBJECT, FOR EXAMPLE)
 250  IF(LECHO)WRITE(ODEV1,1203)
      LPTR=1000
 251  PRN=250
      CALL NXT(LPTR,NAME,NUM,FNUM,LECHO,IDEV2,&190,&251,&300,&251,
     1 &251,&102)
C     HAVE NAME OF VARIABLE
      CALL NSRCH(NAME,VLIST,1,NVN,K,&192)
      IF(NVCWS.GE.NVCWSM)GO TO 252
      NVCWS=NVCWS+1
      VCWS(NVCWS)=VNUM(K)
      GO TO 251
C
C     VCWS STORAGE OVERFLOW
 252  WRITE(ODEV1,1204)NVCWS
      GO TO 199
C
C------------------------------
C
C     ERROR HANDLING
C
C     TEST TABLE OVERFLOW
 299  WRITE(ODEV1,1201)NTESTS
      GO TO 199
C
C     ILLEGAL CONDITIONS TABLE OVERFLOW
 297  WRITE(ODEV1,1202)NICOND
      GO TO 199
C
C     FORMATS
 1200 FORMAT(1H0,'ILLEGAL COMBINATIONS INFO:')
 1201 FORMAT(' TEST TABLE OVERFLOW  NTESTS=',I6)
 1202 FORMAT(' ICOND TABLE OVERFLOW  NICOND=',I6)
 1203 FORMAT(1H0,'VCWS STRING:')
 1204 FORMAT(' VCWS TABLE OVERFLOW, NVCWS=',I4)
C
C------------------------------
C
C     READ STRING INDICATING STATISTICS TO BE COMPUTED BY DEFAULT
 300  IF(LECHO)WRITE(ODEV1,1300)
      PRN=300
      DO 306 I=1,NSTATS
 306  STTIND(I)=.FALSE.
C
 301  LPTR=1
      CALL INPUT(IDEV2,LECHO,&102,&302)
C
C
 302  CALL NEXT(LPTR,NAME,BC,NUM,FNUM,F,&302,&303,&301)
C
C     DECODE OPTION
 304  CALL NSRCH(NAME,STATNM,1,NAMSTT,I,&398)
      J=STATNO(I)
      IF(J.EQ.-1)GO TO 305
      IF(J.LT.0)GO TO 398
C
C     ENABLE OPTION
      DSTIND(J)=.TRUE.
      STTIND(J)=.TRUE.
      GO TO 302
C
C     ENABLE ALL OPTIONS
 305  DO 307 I=1,NSTATS
      STTIND(I)=.TRUE.
 307  DSTIND(I)=.TRUE.
      GO TO 302
C
C     CHECK BREAK CHAR
 303  CALL ATQ(BC,LPTR,&310)
      GO TO 302
C
C------------------------------
C
C     ILLEGAL STAT OPTION
 398  WRITE(ODEV1,1301)NAME
      LOK=.FALSE.
      GO TO 302
C
C------------------------------
C
 1300 FORMAT(1H0,'STAT DEFAULTS:')
 1301 FORMAT(1H0,'ILLEGAL STAT OPTION: ',8A1)
 1302 FORMAT('0','OUTPUT VARIABLE NAMES')
C
C------------------------------
C
C     READ NAMES OF DEPENDENT/CONCOMITANT VARIABLES
 310  IF(LECHO)WRITE(ODEV1,1302)
      PRN=310
C
C     SET FIRST NAME TO BLANK INITIALLY
      DO 311 J=1,8
 311  OVNAM(J,1)=BLANK
      I=1
      LPTR=1
      CALL INPUT(IDEV2,LECHO,&102,&312)
 312  CALL NEXT(LPTR,OVNAM(1,I),BC,NUM,FNUM,T,&313,&312,&314)
 315  I=I+1
C     STOP AFTER ARRAY OF VARIABLE NAMES IS FULL
      IF(I.GT.NOVNAM)GO TO 314
      GO TO 312
C
C     INAPPROPRIATE NUMBER
 313  WRITE(ODEV1,1105)FNUM
      LOK=.FALSE.
      GO TO 312
C
C     ALL LABELS HAVE BEEN READ
 314  NOV=I-1
      IF(NOV.LE.0)NOV=1
C
C------------------------------
C
C     THIS SECTION IMPLEMENTS PART OF THE SAVEBIN COMMAND
      IF(.NOT.LOK)GO TO 490
      IF(.NOT.SAVBIN)GO TO 452
C     START BY SAVING PRINCIPAL TABLES
      WRITE(ODEV4)VLIST,VNUM,GVNPTR,VSPTR,TYPE,KWR
      WRITE(ODEV4)KWLIST
      WRITE(ODEV4)KVAL,DIVARS,DFVARS,DSPECI,DSPECF,DFLAGS
      WRITE(ODEV4)RANGE,TCONS,RCTR,RPTR,ICOND,TESTS
      WRITE(ODEV4)NOV,NDEF,MAXC1,NOVER,NGRP,NVCWS,NVARS,NVN,NKW,
     1 NRUSED,NTESTS,NICOND,OVNAM,VCWS,DSTIND,COSTPT,ECHOF
C
C     WRITE COMMANDS TABLES, DELETING UNDESIRABLE COMMANDS LIKE SAVEBIN
      DO 450 I=1,NCNAM
      DO 451 J=1,NCUND
      IF(CNUM(I).EQ.UNDCMD(J))GO TO 450
 451  CONTINUE
      WRITE(ODEV4)(CMDTBL(J,I),J=1,8),CNUM(I)
 450  CONTINUE
      END FILE ODEV4
      WRITE(ODEV1,1400)
      GO TO 490
C
C------------------------------
C
C     THIS SECTION IMPLEMENTS PART OF THE SAVECARD COMMAND
 452  IF(.NOT.SAVCRD)GO TO 490
C     BEGIN WITH COUNTERS
      WRITE(ODEV4,1403)NOV,NDEF,MAXC1,NOVER,NGRP,NVCWS,NVARS,NVN,NKW,
     1 NRUSED,NTESTS,NICOND
C
C     NAME/KWD TABLES
      WRITE(ODEV4,1402)((VLIST(I,J),I=1,8),J=1,NVN)
      IF(NKW.GT.0)WRITE(ODEV4,1402)((KWLIST(I,J),I=1,8),J=1,NKW)
      IF(NOV.GT.0)WRITE(ODEV4,1402)((OVNAM(I,J),I=1,8),J=1,NOV)
C
C     MISCELLANEOUS INTEGER TABLES
      WRITE(ODEV4,1401)(VNUM(I),I=1,NVN)
      WRITE(ODEV4,1401)(GVNPTR(I),VSPTR(I),TYPE(I),KWR(1,I),KWR(2,I),
     1 RCTR(I),RPTR(I),I=1,NVARS)
      WRITE(ODEV4,1401)ICOND,VCWS
C
C     SPECIAL INTEGER AND FLOATING POINT TABLES
      IF(NKW.GT.0)WRITE(ODEV4,1403)(KVAL(I),I=1,NKW)
      WRITE(ODEV4,1403)DFVARS
      WRITE(ODEV4,1403)DIVARS,DSPECI,DSPECF
      IF(NRUSED.GT.0)WRITE(ODEV4,1403)(RANGE(1,I),RANGE(2,I),I=1,
     1 NRUSED)
      IF(NTESTS.GT.0)WRITE(ODEV4,1401)((TESTS(I,J),I=1,3),J=1,
     1 NTESTS)
      IF(NTESTS.GT.0)WRITE(ODEV4,1403)(TCONS(I),I=1,NTESTS)
C
C     LOGICAL VARIABLES
      WRITE(ODEV4,1404)DFLAGS,DSTIND,COSTPT,ECHOF
C
C     WRITE COMMANDS TABLES, DELETING UNDESIRABLE COMMANDS
      DO 453 I=1,NCNAM
      DO 454 J=1,NCUND
      IF(CNUM(I).EQ.UNDCMD(J))GO TO 453
 454  CONTINUE
      WRITE(ODEV4,1405)(CMDTBL(J,I),J=1,8),CNUM(I)
 453  CONTINUE
C     TRAILER RECORD
      WRITE(ODEV4,1406)
C
      WRITE(ODEV1,1400)
C
C------------------------------
C
 1400 FORMAT(' ALL TABLES WRITTEN')
 1401 FORMAT(20I4)
 1402 FORMAT(80A1)
 1403 FORMAT(8G10.4)
 1404 FORMAT(80L1)
 1405 FORMAT(8A1,I4)
 1406 FORMAT(8X,'9999')
C
C**************************************************
C
C     COMMAND DECODER SECTION
C
C
C     THIS SECTION WAITS FOR A LINE CONTAINING A SUPERVISOR
C     COMMAND
C
C     REQUEST SUPERVISOR COMMAND
 490  WRITE(ODEV1,5002)
C
C     WAIT FOR COMMAND
 491  ASSIGN 490 TO CMDRTN
      CALL INPUT(IDEV1,ECHOF,&492,&500)
C
C     GOT A LINE WITHOUT A SUPERVISOR COMMAND
 493  WRITE(ODEV1,5001)
      GO TO 491
C
C
C     THIS SECTION IMPLEMENTS THE STOP COMMAND
C     END-OF-FILE INTERPRETED SAME AS STOP COMMAND
C     PRINT STATISTICS
 492  WRITE(ODEV1,5003)NRUNS,TNGRPS
      STOP
C
      GO TO 490
C
C
C     COMMAND DECODER PROPER
C     COME HERE WITH COMMAND IN LINE(80)
C
 500  DO 501 IC3=1,NCPFX
      CALL SFIND(CPFX(1,IC3),LINE,2,80,1,IC1,IC2,&501)
      GO TO 504
 501  CONTINUE
      GO TO 493
C
C     TRY TO FIND OUT WHICH COMMAND IT IS
 504  IC2=IC2+1
      CALL NEXT(IC2,CMD,CBC,NUMC,FNUMC,F,&502,&502,&502)
C     DECODE COMMAND, IF POSSIBLE
      CALL NSRCH(CMD,CMDTBL,1,NCNAM,NCN,&502)
C     GET NUMBER OF COMMAND
      NCMD=CNUM(NCN)
C
C     BRANCH TO COMMAND EXECUTION SECTION
      GO TO (492,599,600,510,511,512,61,599,520,508,513,514,
     1 515,540,516,509,560,561,562,563,564,565),NCMD
      STOP '500'
C
C
C     ILLEGAL COMMAND, OR NONE AT ALL
 502  JMAX=JMAXX(LINE,80)
      WRITE(ODEV1,5005)(LINE(IC2),IC2=IC1,JMAX)
      GO TO 599
C
C     RETURN FROM COMMAND DECODER
 598  WRITE(ODEV1,5006)
 599  GO TO CMDRTN,(490,601,603,607,700,750)
C
C------------------------------
C
C     THIS SECTION IMPLEMENTS THE COMMANDS COMMAND
 508  IC1=0
      WRITE(ODEV1,5007)
      DO 507 IC2=1,NCNAM
      IF(IC1.EQ.CNUM(IC2))GO TO 507
      WRITE(ODEV1,1542)(CMDTBL(IC1,IC2),IC1=1,8)
      IC1=CNUM(IC2)
 507  CONTINUE
      WRITE(ODEV1,1525)
      GO TO 599
C
C
C     THIS SECTION IMPLEMENTS THE ECHO COMMAND
 510  ECHOF=.TRUE.
      WRITE(ODEV1,5006)
      GO TO 599
C
C
C     THIS SECTION IMPLEMENTS THE NOECHO COMMAND
 511  ECHOF=.FALSE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE LECHO COMMAND
 512  IF(.NOT.LOOPT)GO TO 502
      LECHO=.TRUE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE SHORT COMMAND
 513  SHORT=.TRUE.
      VSHORT=.FALSE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE VSHORT COMMAND
 514  VSHORT=.TRUE.
      SHORT=.FALSE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE LONG COMMAND
 515  SHORT=.FALSE.
      VSHORT=.FALSE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE REPEAT COMMAND
 516  RPT=.TRUE.
      NRPT1=0
C     DEFAULT REPEAT COUNT IS 2
      NRPT=2
C     LOOK FOR COUNT IN COMMAND
 517  CALL NEXT(IC2,CMD,CBC,NUMC,FNUMC,F,&518,&517,&598)
      GO TO 519
C
C     HAVE COUNT
 518  NRPT=NUMC
      IF(NRPT.GT.0 .AND. NRPT.LE.500)GO TO 598
 519  RPT=.FALSE.
      GO TO 502
C
C
C     THIS SECTION IMPLEMENTS THE NORPT COMMAND
 509  RPT=.FALSE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE SAVEBIN COMMAND
 560  IF(.NOT.LOOPT .OR. SAVCRD)GO TO 502
      SAVBIN=.TRUE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE SAVECARD COMMAND
 561  IF(.NOT.LOOPT .OR. SAVBIN)GO TO 502
      SAVCRD=.TRUE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE DATAOUT COMMAND
 562  DATOUT=.TRUE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE NODATOUT COMMAND
 563  DATOUT=.FALSE.
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE XPRINT COMMAND
 564  SINK=ODEV3
      GO TO 598
C
C
C     THIS SECTION IMPLEMENTS THE NOXPRINT COMMAND
 565  SINK=ODEV1
      GO TO 598
C
C------------------------------
C
 5001 FORMAT(' NO SUPERVISOR COMMAND IN PRECEDING LINE.'/)
 5002 FORMAT(1H0,'ENTER SUPERVISOR COMMAND'/)
 5003 FORMAT(1H0,4X,'NUMBER OF EXPERIMENTAL RUNS',I5/
     1	5X,'NUMBER OF GROUPS SIMULATED ',I5/)
 5005 FORMAT(' ILLEGAL COMMAND: ',80A1)
 5006 FORMAT(' OK')
 5007 FORMAT(1H0,'COMMANDS AVAILABLE:')
C
C------------------------------
C
C     THIS SECTION IMPLEMENTS THE VARS COMMAND
C     PRINT HEADING
 520  WRITE(ODEV1,1520)
C
      DO 521 NV5=1,NVARS
C     SKIP INTERNAL-ONLY VARIABLES
      IF(TYPE(NV5).GT.7)GO TO 521
C     GET VARIABLE NAME
      J50=GVNPTR(NV5)
      DO 522 K50=1,8
 522  NAME(K50)=VLIST(K50,J50)
C
C     BRANCH ON TYPE
      I50=TYPE(NV5)
      GO TO (523,523,524,524,524,524,525),I50
      STOP '521'
C
C     FLAG VARIABLES ARE EASY
 525  WRITE(ODEV1,1522)NAME
      GO TO 521
C
C     KWD,KI,KF,IND VARIABLES
 524  J50=KWR(1,NV5)
      K50=KWR(2,NV5)
      L50=1000
      M50=KVAL(J50)+1
C
C     PRINT LIST OF ALL KEYWORD VALUES
      DO 526 N50=J50,K50
C     JUST PRINT 1ST KWD NAME FOR EACH KWD VALUE
      IF(KVAL(N50).EQ.M50)GO TO 526
      M50=KVAL(N50)
      IF(L50.LE.51)GO TO 527
      IF(N50.EQ.J50)GO TO 528
C
C     PRINT LINE
      JMAX=JMAXX(LINE,80)
      WRITE(ODEV1,1522) NAME,(LINE(III),III=1,JMAX)
C     ERASE NAME
      DO 529 I51=1,8
 529  NAME(I51)=BLANK
C     ERASE LINE
 528  DO 530 I51=1,80
 530  LINE(I51)=BLANK
      L50=1
C
C     INSERT KWD IN LINE
 527  DO 531 I51=1,8
      LINE(L50)=KWLIST(I51,N50)
 531  L50=L50+1
      L50=L50+2
 526  CONTINUE
C
C     FINISH LAST LINE
C        WRITE(ODEV1,1522)NAME,LINE
      JMAX=JMAXX(LINE,80)
      WRITE(ODEV1,1522) NAME, (LINE(III),III=1,JMAX)
C
      DO 532 I51=1,8
 532  NAME(I51)=BLANK
C
C     BRANCH ON TYPE AGAIN
      IF(TYPE(NV5).NE.4 .AND. TYPE(NV5).NE.5)GO TO 521
C
C     NUMI,NUMF,KI, AND KF VARIABLES
 523  IF(RCTR(NV5).GT.0)GO TO 533
C
C     NO LIMITATIONS ON VALUE OF VARIABLE
      WRITE(ODEV1,1523)NAME
      GO TO 521
C
C     PRINT NUMERIC RANGES
 533  J50=RCTR(NV5)
      K50=RPTR(NV5)
      DO 534 L50=1,J50
      M50=K50+L50-1
      WRITE(ODEV1,1524)NAME,RANGE(1,M50),RANGE(2,M50)
      DO 535 I51=1,8
 535  NAME(I51)=BLANK
 534  CONTINUE
 521  CONTINUE
      WRITE(ODEV1,1525)
      GO TO 599
C
C------------------------------
C
 1520 FORMAT(1H0,'VARIABLE   LEGAL VALUES')
 1522 FORMAT(1X,8A1,3X,80A1)
 1523 FORMAT(1X,8A1,3X,'ANY NUMERIC VALUE')
 1524 FORMAT(1X,8A1,2X,G10.4,' TO ',G10.4)
 1525 FORMAT('0 ')
C
C------------------------------
C
C     THIS SECTION IMPLEMENTS THE STAT COMMAND
C
C     READ NEXT STAT OPTION FROM LIST
 540  CALL NEXT(IC2,CMD,CBC,NUMC,FNUMC,F,&540,&540,&541)
C
C     DECODE OPTION
 542  CALL NSRCH(CMD,STATNM,1,NAMSTT,NCN,&543)
      NCMD=STATNO(NCN)
      IF(NCMD.LT.0)GO TO 544
C
C     ENABLE THE OPTION SPECIFIED
      STTIND(NCMD)=.TRUE.
      GO TO 540
C
C     BRANCH ON VALUE
 544  NCMD=-NCMD
      GO TO (546,547,552,553),NCMD
      STOP '500'
C
C     -1 = ALL
 546  DO 548 IC1=1,NSTATS
 548  STTIND(IC1)=.TRUE.
      GO TO 540
C
C     -2 = OFF
 547  DO 549 IC1=1,NSTATS
 549  STTIND(IC1)=.FALSE.
      GO TO 540
C
C     -3 = AUTODEF
 552  AUTDEF=.TRUE.
      GO TO 540
C
C     -4 = NOAUTODF
 553  AUTDEF=.FALSE.
      GO TO 540
C
C     EOL MEANS END OF STAT OPTIONS
C     PRINT THE OPTIONS CURRENTLY ENABLED
541   LT=.TRUE.
      WRITE(ODEV1,1541)
      DO 551 IC1=1,NSTATS
      IF(.NOT.STTIND(IC1))GO TO 551
      LT=.FALSE.
      IC2=GSONM(IC1)
C     WRITE GENERIC NAME OF STATISTIC
      WRITE(ODEV1,1542)(STATNM(I551,IC2),I551=1,8)
 551  CONTINUE
      IF(LT)WRITE(ODEV1,1543)
      GO TO 599
C
C     UNIDENTIFIABLE STAT OPTION
 543  WRITE(ODEV1,1540)CMD
      GO TO 540
C
C------------------------------
C
 1540 FORMAT(' ''',8A1,''' IS UNIDENTIFIABLE.')
 1541 FORMAT(' STATISTICS OPTIONS ENABLED:')
 1542 FORMAT(4X,8A1)
 1543 FORMAT(4X,'NONE')
C
C**************************************************
C
C     THIS SECTION RUNS SIMULATED EXPERIMENTS
C
 600  IF(.NOT.LOK)GO TO 502
      EOK=.TRUE.
      IF(.NOT.EXPTON)GO TO 617
      WRITE(ODEV1,1614)
      IF(.NOT.AUTDEF)GO TO 617
C
C     SET UP DEFAULT STATISTICS
      DO 618 I=1,NSTATS
 618  STTIND(I)=DSTIND(I)
      WRITE(ODEV1,1706)
C
 617  EXPTON=.TRUE.
      NRUNS=NRUNS+1
C
C     GET ID LINE
 601  WRITE(ODEV1,1600)
      ASSIGN 601 TO CMDRTN
      CALL INPUT(IDEV1,ECHOF,&492,&500)
      DO 602 I=1,80
 602  IDLINE(I)=LINE(I)
C
C     REQUEST NO. OF EXPTL CONDITIONS
      ASSIGN 603 TO CMDRTN
 603  WRITE(ODEV1,1601)
      CALL INPUT(IDEV1,ECHOF,&492,&500)
      LPTR=1
 605  CALL NEXT(LPTR,NAME,BC,NUM,FNUM,F,&604,&605,&699)
      GO TO 697
C
C     TEST LEGALITY
 604  IF(NUM.LE.0 .OR. NUM.GT.MAXC)GO TO 696
      NC=NUM
C
C------------------------------
C
C     ASK STUDENT TO DEFINE EXPERIMENTAL CONDITIONS
      NPC=0
      IERROR=0
 606  ASSIGN 607 TO CMDRTN
      WRITE(ODEV1,1602)
      CALL INTERP(IDEV1,0,ECHOF,NVARS,NVN,NKW,NIVMAX,NFVMAX,NFGMAX,
     1 NERR,MAXC,NPC,NCG,VLIST,VNUM,GVNPTR,VSPTR,TYPE,ENTERD,KWR,
     2 KWLIST,KVAL,IVARS,SPECI,DIVARS,DSPECI,FVARS,SPECF,DFVARS,DSPECF,
     3 FLAGS,DFLAGS,&492,&500)
C
 609  IERROR=IERROR+NERR
      NPC=NPC+NCG
      WRITE(ODEV1,1603)NPC
      IF(NC-NPC)695,608,606
C
C
 607  WRITE(ODEV1,1615)
      CALL INTP1(NERR,NCG,&492,&500)
      GO TO 609
C
C
C     ALL CONDITIONS HAVE BEEN DEFINED
 608  IF(IERROR.GT.0)GO TO 694
C
      DO 610 I=1,NVARS
 610  VF(I)=.FALSE.
C
      IF(VSHORT .OR. NC.EQ.1)GO TO 615
C
C     PRINT LIST OF VARIABLES WHOSE SETTINGS ARE CONSTANT
C     ACROSS ALL CONDITIONS, UNLESS SHORT OR VSHORT IN EFFECT
C
C     FIGURE OUT WHICH VARIABLES IN FACT ARE CONSTANT
      DO 611 I=1,NVARS
      VP=VSPTR(I)
      TP=TYPE(I)
      CALL VALUE(VP,TP,1,X1,IX1,&613)
 613  DO 612 J=2,NC
      JTMP=J
      CALL VALUE(VP,TP,JTMP,X2,IX2,&614)
      IF(X1.NE.X2 .OR. IX1.NE.IX2)GO TO 611
      GO TO 612
 614  IF((FLAGS(VP,1).AND. .NOT.FLAGS(VP,J)) .OR.
     1	 (.NOT.FLAGS(VP,1).AND.FLAGS(VP,J)))GO TO 611
 612  CONTINUE
      VF(I)=.TRUE.
 611  CONTINUE
      IF(SHORT)GO TO 615
C
C     PRINT LIST
      NC1=1
      WRITE(SINK,1604)
      ASSIGN 615 TO I670
      GO TO 670
C
 615  DO 616 I=1,NVARS
 616  VF(I)=.NOT.VF(I)
      IF((SHORT.OR.NC.EQ.1) .AND. .NOT.VSHORT)WRITE(SINK,1612)
C
C
C     PRINT VALUES FOR EACH CONDITION (UNLESS VSHORT=T) WITH ERROR
C     MESSAGES AS APPROPRIATE
      DO 620 NC1=1,NC
      EPRNT=.TRUE.
      NC1TMP=NC1
      CALL CCHARS(NC1TMP,CC)
      IF(VSHORT)GO TO 621
C
C     CONDITION HEADER
      WRITE(SINK, 1607)CC
C     PRINT VALUES
      ASSIGN 621 TO I670
      GO TO 670
C
C------------------------------
C
C     SEE IF VALUES ARE IN PROPER RANGES
 621  DO 622 NV=1,NVARS
      IF(RCTR(NV).LE.0)GO TO 622
      I1=RCTR(NV)
      I2=RPTR(NV)
      NVTMP=NV
      CALL VALUE(VSPTR(NVTMP),TYPE(NVTMP),NC1TMP,X1,IX1,&622)
      IF(IX1.NE.0)GO TO 622
C
      DO 623 I=1,I1
      J=I2+I-1
      IF(RANGE(1,J).LE.X1 .AND. X1.LE.RANGE(2,J))GO TO 622
 623  CONTINUE
C
C     ILLEGAL VALUE
      IF(EPRNT.AND.VSHORT)WRITE(ODEV1,1613)CC
      EPRNT=.FALSE.
      I1=GVNPTR(NV)
      WRITE(ODEV1,1608)(VLIST(J,I1),J=1,8)
      EOK=.FALSE.
 622  CONTINUE
C
C------------------------------
C
C     TEST FOR OTHER ILLEGAL CONDITIONS, IF ANY
      IF(NICOND.LE.0)GO TO 620
      DO 625 I=1,NICOND
      I1=ICOND(1,I)
      I2=ICOND(2,I)
C
C     CHECK FOR ILLEGAL CONDITION
      DO 626 J=I1,I2
      NV1=TESTS(1,J)
      NV1=IABS(NV1)
C
C     GET VALUE FOR 1ST VARIABLE
      JTMP=J
      CALL EVAL(TESTS(1,JTMP),TYPE(NV1),VSPTR(NV1),NC1TMP,X1,&625)
C
      K=TESTS(2,J)
      K=IABS(K)
      IF(K.NE.1)GO TO 630
C
C     RANGE TEST
      K=TESTS(3,J)
      TV=RANGE(1,K).LE.X1 .AND. X1.LE.RANGE(2,K)
      GO TO 631
C
C     GET X2 VALUE
 630  IF(TESTS(3,J).NE.0)GO TO 632
C     X2=CONSTANT
      X2=TCONS(J)
      GO TO 633
C     X2=VARIABLE
 632  NV2=TESTS(3,J)
      NV2=IABS(NV2)
      CALL EVAL(TESTS(3,JTMP),TYPE(NV2),VSPTR(NV2),NC1TMP,X2,&625)
C
 633  TV=(K.EQ.2 .AND. X1.EQ.X2).OR.(K.EQ.3 .AND. X1.GT.X2).OR.
     1 (K.EQ.4 .AND. X1.LT.X2)
C
 631  IF(TESTS(2,J).LT.0)TV=.NOT.TV
      IF(.NOT.TV)GO TO 625
 626  CONTINUE
C
C     ILLEGAL CONDITION HOLDS
      EOK=.FALSE.
      IF(EPRNT.AND.VSHORT)WRITE(ODEV1,1613)CC
      EPRNT=.FALSE.
      WRITE(ODEV1,1609)
C
C     PRINT LIST OF VARIABLES INVOLVED IN ERROR
      PF=.FALSE.
      LPTR=100
      DO 634 J=I1,I2
      M=1
 638  K=TESTS(M,J)
      K=IABS(K)
      K=GVNPTR(K)
C
      IF(LPTR.LE.64)GO TO 635
      IF(PF)WRITE(ODEV1,1102)LINE
      PF=.TRUE.
      DO 636 L=1,80
 636  LINE(L)=BLANK
      LPTR=1
C
 635  DO 637 L=1,8
      LINE(LPTR)=VLIST(L,K)
 637  LPTR=LPTR+1
      LPTR=LPTR+1
C
      IF(M.NE.1)GO TO 634
      IF(TESTS(2,J).EQ.1 .OR. TESTS(2,J).EQ.-1 .OR. TESTS(3,J).EQ.0)
     1 GO TO 634
      M=3
      GO TO 638
 634  CONTINUE
      WRITE(ODEV1,1102)LINE
C
 625  CONTINUE
 620  CONTINUE
      NC1=NC
      IF(.NOT.EOK)GO TO 694
      GO TO 700
C
C------------------------------
C
C     THIS SECTION PRINTS VALUES FOR ALL EXTERNAL VARIABLES
C     INDICATED BY TRUE VALUES IN VF
C     VALUES ARE THOSE FOR CONDITION NC1
C
 670  NVPTD=0
C
C     FIRST PRINT ALL VARIABLES WITH KWD VALUES
      N67=1
      DO 671 I67=1,NVARS
      IF(.NOT.VF(I67))GO TO 671
      J67=TYPE(I67)
      GO TO (671,671,672,673,673,672,671,671,671,671),J67
      STOP '670'
C
C     KI/KF VARIABLES
 673  CALL VALUE(VSPTR(I67),TYPE(I67),NC1,X,IX,&695)
      IF(IX.EQ.0)GO TO 671
      GO TO 674
C
C     KWD/IND VARIABLES
 672  J67=VSPTR(I67)
      IX=IVARS(J67,NC1)
C
C     GET GENERIC KWD NAME
 674  NVPTD=NVPTD+1
      L67=KWR(1,I67)
      M67=KWR(2,I67)
      DO 675 J67=L67,M67
      IF(KVAL(J67).EQ.IX)GO TO 676
 675  CONTINUE
      STOP '675'
C     PUT KWD IN OUTPUT LIST
 676  DO 677 K67=1,8
 677  KWVEC(K67,N67)=KWLIST(K67,J67)
C
C     PUT GENERIC VARIABLE NAME IN OUTPUT LIST
      CALL RJUST(NVEC,N67,VLIST,GVNPTR(I67))
      N67=N67+1
      IF(N67.LE.3)GO TO 671
      N67=1
      WRITE(SINK,1605)((NVEC(K67,L67),K67=1,8),(KWVEC(M67,L67),
     1 M67=1,8),L67=1,3)
 671  CONTINUE
C
C     FINISH OUTPUT LINE
      IF(N67.LE.1)GO TO 678
      N67=N67-1
      WRITE(SINK,1605)((NVEC(K67,L67),K67=1,8),(KWVEC(M67,L67),
     1 M67=1,8),L67=1,N67)
C
C     NOW ALL NUMERIC-VALUED VARIABLES
 678  N67=1
      DO 680 I67=1,NVARS
      IF(.NOT.VF(I67))GO TO 680
      J67=TYPE(I67)
      GO TO (682,682,680,682,682,680,680,680,680,680),J67
      STOP '680'
C
 682  CALL VALUE(VSPTR(I67),TYPE(I67),NC1,FVEC(N67),IX,&680)
      IF(IX.NE.0)GO TO 680
      NVPTD=NVPTD+1
C
C     PUT NAME IN OUTPUT ARRAY
      CALL RJUST(NVEC,N67,VLIST,GVNPTR(I67))
      N67=N67+1
      IF(N67.LE.3)GO TO 680
      N67=1
      WRITE(SINK,1606)((NVEC(J67,K67),J67=1,8),FVEC(K67),K67=1,3)
 680  CONTINUE
      N67=N67-1
      IF(N67.LE.0)GO TO 681
      WRITE(SINK,1606)((NVEC(J67,K67),J67=1,8),FVEC(K67),K67=1,N67)
C
C     PRINT FLAG VARIABLES
 681  N67=1
      DO 683 I67=1,NVARS
      IF((.NOT.VF(I67)) .OR. (TYPE(I67).NE.7))GO TO 683
      J67=VSPTR(I67)
      IF(.NOT.FLAGS(J67,NC1))GO TO 683
      NVPTD=NVPTD+1
C
C     FLAG IS UP--PUT VARIABLE NAME IN OUTPUT ARRAY
      CALL RJUST(NVEC,N67,VLIST,GVNPTR(I67))
      N67=N67+1
      IF(N67.LE.3)GO TO 683
      N67=1
      WRITE(SINK,1616)NVEC
 683  CONTINUE
      N67=N67-1
      IF(N67.GT.0)WRITE(SINK,1616)((NVEC(J67,K67),J67=1,8),K67=1,N67)
C
C     IF NO VARIABLES WERE PRINTED, WRITE 'NONE'
      IF(NVPTD.LE.0)WRITE(SINK,1611)
C     RETURN
      GO TO I670,(615,621)
C
C------------------------------
C
 1600 FORMAT(1H0,'ENTER EXPERIMENT ID LINE'/)
 1601 FORMAT(1H0,'ENTER NO. OF EXPERIMENTAL CONDITIONS'/)
 1602 FORMAT(1H0,'DEFINE EXPERIMENTAL CONDITION(S)'/)
 1603 FORMAT(1X,I5,' CONDITION(S) DEFINED')
 1604 FORMAT(1H1,'THE FOLLOWING VARIABLE SETTINGS ARE CONSTANT',
     1 ' ACROSS ALL CONDITIONS:')
 1605 FORMAT(5X,3(8A1,'=',8A1,3X))
 1606 FORMAT((5X,3(8A1,'=',G10.4,1X)))
 1607 FORMAT(1H0,2X,'VARIABLE SETTINGS FOR CONDITION ',2A1)
 1608 FORMAT(' THE VALUE FOR VARIABLE ',8A1,' IS ILLEGAL')
 1609 FORMAT(' ILLEGAL COMBINATION OF VALUES INVOLVING VARIABLES:')
 1610 FORMAT(1H0,'EXPERIMENT ABORTED DUE TO ERRORS IN INPUT')
 1611 FORMAT(5X,'NONE')
 1612 FORMAT(1H2)
 1613 FORMAT(' CONDITION ',2A1)
 1614 FORMAT(' PREVIOUS EXPERIMENT TERMINATED BY COMMAND')
 1615 FORMAT(' FINISH DEFINING CONDITION(S)'/)
 1616 FORMAT(5X,3(4X,8A1,8X))
C
C------------------------------
C
C     ERROR HANDLING
C
C     NO. OF EXPTL CONDITIONS WAS NOT GIVEN
 699  WRITE(ODEV1,1620)
      GO TO 694
C
C     NAME WHERE THERE SHOULD HAVE BEEN SOMETHING ELSE
 697  WRITE(ODEV1,1621)NAME
      GO TO 694
C
C     NO. OF CONDITIONS IS OUTSIDE THE RANGE (1,MAXC)
 696  WRITE(ODEV1,1622)NUM,MAXC
      GO TO 694
C
C     TOO MANY CONDITIONS GENERATED
 695  WRITE(ODEV1,1623)NC
C
C
C     MOST FATAL ERRORS IN STUDENT INPUT EXIT THRU HERE
 694  WRITE(ODEV1,1624)
      EXPTON=.FALSE.
C
C     TAKE CARE OF AUTODEFAULTING OF STATISTICS
      IF(.NOT.AUTDEF)GO TO 490
      DO 693 I=1,NSTATS
 693  STTIND(I)=DSTIND(I)
      WRITE(ODEV1,1706)
      GO TO 490
C
C------------------------------
C
 1620 FORMAT(1H0,'NO. OF EXPTL CONDITIONS WAS NOT SPECIFIED.')
 1621 FORMAT(1H0,'''',8A1,''' APPEARS WHERE SOMETHING ELSE',
     1 ' SHOULD BE.')
 1622 FORMAT(1H0,'NUMBER OF CONDITIONS GIVEN,',I5,', IS OUTSIDE',
     1 ' THE RANGE ( 1,',I3,').')
 1623 FORMAT(1H0,'MORE THAN ',I3,' CONDITIONS GENERATED BY COND',
     1 'ITION DEFINITION INFO.')
 1624 FORMAT(1H0,'EXPERIMENT CANCELLED DUE TO ERRORS IN INPUT.'/1H1)
C
C------------------------------
C
C     READ NO. OF SUBJECTS PER GROUP
 700  WRITE(ODEV1,1700)
      ASSIGN 700 TO CMDRTN
      CALL INPUT(IDEV1,ECHOF,&492,&500)
      LPTR=1
      WDES=.FALSE.
      NGP=0
C
 701  CALL NEXT(LPTR,NAME,BC,NUM,FNUM,F,&702,&701,&705)
C
C     NAME BETTER BE 'R*', 'W*', OR 'S*' TO INDICATE REPEATED
C     MEASURES DESIGN
      DO 703 I=1,3
      CALL NMATCH(REPMES(1,I),NAME,&703)
C
C     REPEATED MEASURES DESIGN IS INDICATED
      WDES=.TRUE.
      IF(MAXC1.GT.1)GO TO 701
C
C     REPEATED MEASURES DESIGNS NOT ALLOWED BY THIS MODEL
      WDES=.FALSE.
      WRITE(ODEV1,1713)
      GO TO 700
C
 703  CONTINUE
C     UNIDENTIFIABLE NAME
      GO TO 799
C
C     HAVE A GRP SIZE--PROBABLY
 702  IF(NGP.GE.NC)GO TO 797
      NGP=NGP+1
      IF(NUM.LE.0 .OR. NUM.GT.NGRP)GO TO 798
      NPG(NGP)=NUM
      GO TO 701
C
C     END OF GROUP SIZES LINE
 705  IF(NGP.EQ.0)NPG(1)=NDEF
      IF(WDES)GO TO 755
C
C     HAVE BETWEEN-SUBJECTS DESIGN
C     FILL OUT GROUP SIZES TABLE
      I=MAX0(NGP,1)
      IF(I.GE.NC)GO TO 706
      J=I+1
      DO 707 K=J,NC
 707  NPG(K)=NPG(I)
C
C     MAKE SURE OVERALL N IS OK
 706  N=0
      DO 708 I=1,NC
 708  N=N+NPG(I)
      IF(N.GT.NOVER)GO TO 796
C
C------------------------------
C
C     SIMULATE EACH CONDITION
      NC1=1
 712  DO 710 NGP=1,NC
      CONDS(1)=NGP
C     USE OF M99 NECESSITATED BY A BUG IN THE FORTRAN (G) COMPILER
	   M99=NGP
      N=NPG(M99)
C
C     PRINT HEADING
      ASSIGN 711 TO I740
      GO TO 740
 711  NGPTMP=NGP
      CALL CVALS(NGPTMP)
      CALL MODEL(N,1,&694)
C
 710  TNGRPS=TNGRPS+1
C
C	    THIS SECTION IMPLEMENTS THE REPEAT COMMAND FOR BETWEEN-SS DESIGNS
      IF(.NOT.RPT)GO TO 725
      WRITE(SINK,1708)
      NRPT1=NRPT1+1
      IF(NRPT1.LT.NRPT)GO TO 712
      NRPT1=0
      WRITE(ODEV1,1709)NRPT
C
C     END OF EXPERIMENT
 725  EXPTON=.FALSE.
      WRITE(ODEV1,1705)
C
C     FIX STATISTICS
      IF(.NOT.AUTDEF)GO TO 490
C
C     SET UP DEFAULT STATISTICS
      DO 726 I=1,NSTATS
 726  STTIND(I)=DSTIND(I)
      WRITE(ODEV1,1706)
      GO TO 490
C
C------------------------------
C
C     WITHIN-SUBJECTS DESIGNS HANDLED HERE
 755  ASSIGN 750 TO CMDRTN
      NGP=0
C
C     REQUEST LINE WITH CONDITION LABELS OR COMMAND
 750  WRITE(ODEV1,1710)
      CALL INPUT(IDEV1,ECHOF,&492,&500)
      LPTR=1
      NC1=0
      N=NPG(1)
C     PARSE LINE FOR CONDITION LABELS AND N (OPTIONAL)
 751  CALL NEXT(LPTR,NAME,BC,NUM,FNUM,F,&752,&751,&753)
C
C     FIND OUT WHAT CONDITION IS INDICATED
      CALL CCNUM(NAME,I,NC,&750)
      NC1=NC1+1
      IF(NC1.GT.MAXC1)GO TO 756
      CONDS(NC1)=I
      GO TO 751
C
C     NUMBER IS ASSUMED TO BE A GROUP SIZE
 752  IF(NUM.LE.0 .OR. NUM.GT.NGRP)GO TO 757
      N=NUM
      GO TO 751
C
C------------------------------
C
C     MAKE SURE THIS COMBINATION OF CONDITIONS IS OK
 753  IF(NC1.LE.0)GO TO 750
      IF(NVCWS.LE.0 .OR. NC1.EQ.1)GO TO 770
C
C     TEST THOSE VARIABLES WHICH MUST BE HELD CONSTANT ACROSS CONDITIONS
      DO 760 I=1,NVCWS
      NUM=VCWS(I)
      K=TYPE(NUM)
      L=CONDS(1)
C     BRANCH ON VARIABLE TYPE
      GO TO (761,762,761,761,762,761,763,760,760,760),K
C
C     INTEGER VARIABLES
 761  K=VSPTR(NUM)
      I751=IVARS(K,L)
      I752=SPECI(K,L)
      DO 764 J=2,NC1
      L=CONDS(J)
      IF(IVARS(K,L).NE.I751 .OR. SPECI(K,L).NE.I752)GO TO 795
 764  CONTINUE
      GO TO 760
C
C     FLOATING POINT VARIABLES
 762  K=VSPTR(NUM)
      X1=FVARS(K,L)
      I752=SPECF(K,L)
      DO 765 J=2,NC1
      L=CONDS(J)
      IF(FVARS(K,L).NE.X1 .OR. SPECF(K,L).NE.I752)GO TO 795
 765  CONTINUE
      GO TO 760
C
C     FLAG VARIABLES
 763  K=VSPTR(NUM)
      TV=FLAGS(K,L)
      DO 766 J=2,NC1
      L=CONDS(J)
      IF(TV.AND.FLAGS(K,L))GO TO 766
      IF(TV.OR.FLAGS(K,L))GO TO 795
 766  CONTINUE
 760  CONTINUE
C
C------------------------------
C
C     SIMULATE THIS GROUP
 770  NGP=NGP+1
C     PRINT HEADING
 771  ASSIGN 772 TO I740
      GO TO 740
C
 772  CALL MODEL(N,NC1,&750)
      TNGRPS=TNGRPS+1
C
C     THIS SECTION IMPLEMENTS THE REPEAT COMMAND FOR WITHIN-SS DESIGNS
      IF(.NOT.RPT)GO TO 750
      NRPT1=NRPT1+1
      WRITE(SINK,1708)
      IF(NRPT1.LT.NRPT)GO TO 771
      NRPT1=0
      WRITE(ODEV1,1709)NRPT
      GO TO 750
C
C------------------------------
C
C     THIS SECTION PRINTS HEADING BEFORE OUTPUT FOR EACH EXPTL GRP
 740  WRITE(SINK,1744)
      IF(SHORT.OR.VSHORT)GO TO 744
      WRITE(SINK,1740)
      JMAX=JMAXX(IDLINE,80)
      WRITE(SINK,1102) (IDLINE(III),III=1,JMAX)
      CALL TANDD
      WRITE(SINK,1741)NGP
 744  DO 741 I74=1,16
      CCH(1,I74)=BLANK
 741  CCH(2,I74)=BLANK
      DO 742 I74=1,NC1
      J74=CONDS(I74)
      CALL CCHARS(J74,CC)
      CCH(1,I74)=CC(1)
 742  CCH(2,I74)=CC(2)
      JMAX=INT(JMAXX(CCH,32)/2.0)+1
      WRITE(SINK,1742) ((CCH(III,JJJ),III=1,2),JJJ=1,JMAX)
      WRITE(SINK,1743)N
      GO TO I740,(711,772)
C
C------------------------------
C
 1740 FORMAT(1H2/' ')
 1741 FORMAT(' GROUP NUMBER',I3)
 1742 FORMAT(' CONDITION(S): ',16(2A1,1X))
 1743 FORMAT(' NUMBER OF SUBJECTS:',I5)
 1744 FORMAT(1H0)
C
C------------------------------
C
C     ERROR HANDLING
C
C     UNIDENTIFIABLE NAME IN GROUP SIZE LINE
 799  WRITE(ODEV1,1701)NAME
      GO TO 694
C
C     ILLEGAL VALUE OF N FOR A SINGLE GROUP
 798  WRITE(ODEV1,1702)NGP,NUM
      GO TO 694
C
C     NPG LIST OVERFLOW
 797  WRITE(ODEV1,1703)NGP
      GO TO 694
C
C     OVERALL N TOO LARGE
 796  WRITE(ODEV1,1704)N,NOVER
      GO TO 694
C
C     VARIABLE NOT CONSTANT ACROSS CONDITIONS WHEN IT SHOULD BE
 795  L=GVNPTR(NUM)
      WRITE(ODEV1,1707)(VLIST(J,L),J=1,8)
      GO TO 750
C
C     USER IS TRYING TO APPLY TOO MANY CONDITIONS TO THE SUBJECTS
 756  WRITE(ODEV1,1711)MAXC1
      GO TO 750
C
C     INVALID GROUP SIZE IN WITHIN-SS DESIGN
 757  N=NGP+1
      WRITE(ODEV1,1702)N,NUM
      GO TO 750
C
C------------------------------
C
 1700 FORMAT(1H0,' ENTER NO. OF SUBJECTS IN EACH GROUP'/)
 1701 FORMAT(1H0,'UNIDENTIFIABLE NAME IN GROUP SIZES LINE: ',8A1)
 1702 FORMAT(1H0,'ILLEGAL VALUE OF N FOR GROUP',I3,'  N=',I5)
 1703 FORMAT(1H0,'MORE THAN',I3,' GROUP SIZES GIVEN')
 1704 FORMAT(1H0,'OVERALL N=',I5,'  LIMIT ON N=',I5)
 1705 FORMAT(1H0,1X,'EXPERIMENT COMPLETED.'/1H1)
 1706 FORMAT(1X,'DEFAULT STATISTICS IN EFFECT')
 1707 FORMAT(1H0,8A1,' MUST BE CONSTANT ACROSS CONDITIONS')
 1708 FORMAT('1 ')
 1709 FORMAT(1X,I4,' GROUPS SIMULATED')
 1710 FORMAT(1H1,'ENTER CONDITIONS FOR NEXT GROUP OR COMMAND'/)
 1711 FORMAT('  NO MORE THAN 'I3,' CONDITIONS MAY BE ENTERED'/)
 1713 FORMAT(1X,'WITHIN-SS DESIGNS NOT ALLOWED BY THIS MODEL'/)
       END