C MICHIGAN EXPERIMENTAL SIMULATION SUPERVISOR C VERSION 3-SB C JANUARY, 1973 C ROBERT 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) 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 MAXIMUM 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 INTEGER*4 VCWS(12) C C------------------------------ C C SYSTEM PARAMETERS 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 !! DATA NIVMAX/12/,NFVMAX/12/,NFGMAX/12/ !! DATA MAXC/32/ 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) REAL*4 FNUM,X,X1,X2 !! 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,T,F,ECHOF !! DATA T/.TRUE./, F/.FALSE./ 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 !! DATA RPT/.FALSE./ 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) !! 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 DOUBLE PRECISION MODNM1,MODNM2,MODNM3 COMMON /DATANM/ MODNM1,MODNM2,MODNM3 C C ACTIVE DATA STATEMENTS DATA MAXCWS/16/ DATA NIVMAX/12/,NFVMAX/12/,NFGMAX/12/ DATA MAXC/32/ 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 NCMDS/22/, NCNAM/0/, NCNMAX/44/, NRUNS/0/, TNGRPS/0/ DATA NCPFX/3/, CPFX/'>','>','<','<','&','&'/ DATA RPT/.FALSE./ 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 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',MODE='BINARY',FILE=MODNM3, 1DIRECTORY='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(NOT NORMALLY USED) 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-SB.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) 1102 FORMAT(1X,80A1) C C------------------------------ C C JIGGLE RANDOM NOS. GENERATOR 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 LIST MODEL IDENTIFICATION LINES 101 LPTR=1 READ(IDEV2)LINE C C SEARCH FOR EOS INDICATOR IN LINE CALL SFIND(EOSIND,LINE,4,80,LPTR,I,J,&104) C END OF MODEL IDENT LINES GO TO 107 C C LIST LINE ON ODEV1 104 JMAX=JMAXX(LINE,80) WRITE (ODEV1,1102) (LINE(III),III=1,JMAX) GO TO 101 C C------------------------------ C C READ SIMULATION DATA PREPARED BY PROGRAMMER'S VERSION 107 READ(IDEV2)VLIST,VNUM,GVNPTR,VSPTR,TYPE,KWR READ(IDEV2)KWLIST READ(IDEV2)KVAL,DIVARS,DFVARS,DSPECI,DSPECF,DFLAGS READ(IDEV2)RANGE,TCONS,RCTR,RPTR,ICOND,TESTS READ(IDEV2)NOV,NDEF,MAXC1,NOVER,NGRP,NVCWS,NVARS,NVN,NKW,NRUSED, 1 NTESTS,NICOND,OVNAM,VCWS,DSTIND,COSTPT,ECHOF DO 109 I=1,NSTATS 109 STTIND(I)=DSTIND(I) C C READ TABLE OF COMMANDS I=1 110 READ(IDEV2,END=111)(CMDTBL(J,I),J=1,8),CNUM(I) I=I+1 GO TO 110 C C END OF LOADING 111 NCNAM=I-1 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,502,502,599,520,508,513,514, 1 515,540,516,509,502,502,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 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 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 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 '544' 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 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 CALL EVAL(TESTS(1,J),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,J),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/1H0,'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 MEASURES C 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 DESIGN 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