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