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