C MOTIVATION SIMULATION SUBROUTINE C NOVEMBER 12, 1971 C BOB STOUT, PROGRAMMER C S. MUELLER, SIMULATION DESIGNER, FALL, 1970 C MODEL MODIFIED BY BOB STOUT, NOV. 12, 1971 C MODIFICATION 2, BOB STOUT, AUGUST, 1972 C MODIFICATION 3, BOB STOUT, SEPTEMBER, 1972 C C NOTE: VARIABLES YEAR AND NAFF HAVE NO EFFECTS IN THIS MODEL C SUBROUTINE MODEL(N,NCOND,*) C C STUFF TO INTERFACE WITH SYSTEM INTEGER*4 LINE,SI,SF INTEGER*4 ODEV1,ODV LOGICAL*4 FLGS C COMMON /IO/IDEV(4),ODEV1,ODV(3),LINE(80) COMMON /VARS1/IV(12),FV(12),SI(12),SF(12),FLGS(12) REAL*4 LENGTH INTEGER*4 TSKDIF,SEXE,SEXS,YEAR,FEARF EQUIVALENCE (IDEV3,IDEV(3)), (NGRP,IV(1)), (INSTR,IV(2)), 1 (TSKDIF,IV(3)), (SEXE,IV(4)), (SEXS,IV(5)), (YEAR,IV(6)), 2 (NACH,IV(7)), (NAFF,IV(8)), (FEARF,IV(9)), (LENGTH,FV(1)) C C EFFECT MAGNITUDES TABLES READ BY MINIT REAL*4 LENPWR,LPARA,LPARB(4) REAL*4 NGEFF(2),INSEFF(4),TSKEFA(3),TSKEFB(3) REAL*4 ESXEFA(2),ESXEFB(2),SSXEFF(2) C INTERACTIONS TABLES REAL*4 NACHIN(3,4), FEARIN(3,4) C PROBABILITY DISTNS TABLES REAL*4 PMALE,PNNFR(3,3,3) C C ODDS AND ENDS REAL*4 S(4), DMISS(4) ! DATA DMISS/4*-1./ LOGICAL*4 FNACH,FNAFF,FTAQ,FTAT C DOUBLE PRECISION MODNM1,MODNM2,MODNM3 COMMON /DATANM/ MODNM1,MODNM2,MODNM3 DATA MODNM1/'MOTIV.DAT'/,MODNM2/'MOTIV3.DAT'/,MODNM3/'MOTIV.BIN'/ DATA DMISS/4*-1./ NCOND=NCOND!DEC-10 BUG REQUIRES THIS C C------------------------------ C C SET UP FOR OUTPUT FLGS(4)=.TRUE. FLGS(5)=.FALSE. FLGS(6)=.FALSE. CALL FPOUT1(FLGS,DMISS,&900) C C TAKE CARE OF NACH, NAFF, FEARF, YEAR NUMBER-LETTER EQUIVALENCE NACH=IV(7)+SI(7) NAFF=IV(8)+SI(8) FEARF=IV(9)+SI(9) C YEAR=IV(6)+SI(6) C C TAKE CARE OF 'RANDOM' SETTINGS IF(NACH.EQ.9)NACH=0 IF(NAFF.EQ.9)NAFF=0 IF(FEARF.EQ.9)FEARF=0 C FNACH=NACH.GT.0 FNAFF=NAFF.GT.0 FTAQ=FEARF.GT.0 C C COMPUTE GROUP SIZE CATEGORY C ONLY DIFFERENCE IS BETWEEN SS RUN ALONE VS. SS RUN IN GROUPS NGCAT=1 IF(NGRP.GT.1)NGCAT=2 C C COMPUTE BASE SCORE BASE=(LENGTH**LENPWR)*TSKEFA(TSKDIF)*INSEFF(INSTR)*NGEFF(NGCAT) IS1=1 C C SIMULATE SUBJECTS ONE AT A TIME DO 1 I=1,N C C DETERMINE SEX OF CURRENT SUBJECT ISEXS=SEXS IF(ISEXS.EQ.1 .OR. ISEXS.EQ.2)GO TO 2 C C SEX RANDOMIZED OR BALANCED? IF(ISEXS.LT.1)GO TO 3 C SEXS BALANCED ISEXS=IS1 IS1=3-IS1 GO TO 2 C SEXS RANDOM 3 CALL BINOM(1,PMALE,ISEXS) C C SELECT NACH, NAFF, AND FEARF AS NECESSARY 2 INACH=NACH INAFF=NAFF IFEARF=FEARF CALL CMULNM(PNNFR,3,3,3,1,INACH,INAFF,IFEARF,IX) S(1)=INACH S(2)=INAFF S(3)=IFEARF C C------------------------------ C C ACHIEVEMENT EFFECT DEPENDS ON NACH BY INSTRUCTIONS INTERACTION, C AND ON LENGTH, SEXE, TASK DIFFICULTY, AND SEXS XL=-LPARA*LENGTH ACH=NACHIN(INACH,INSTR)*(1.-EXP(XL))*ESXEFA(SEXE)*TSKEFB(TSKDIF) 1 *SSXEFF(ISEXS) C C ANXIETY EFFECT DEPENDS ON FEARF BY INSTRUCTIONS INTERACTION, C AND ON LENGTH, TASK DIFFICULTY, AND SEXE. XL=LPARB(1)+LPARB(2)/(1.+LPARB(3)*LENGTH+LPARB(4)*LENGTH*LENGTH) ANX=FEARIN(IFEARF,INSTR)*XL*TSKEFB(TSKDIF)*ESXEFB(SEXE) C C COMPUTE MEAN SCORE FOR THIS S XSCORE=BASE*(1.+ACH-ANX) C C WRITE(6,9001)BASE,ACH,ANX,XSCORE,G C9001 FORMAT(1X,6G10.3) C IF(XSCORE.LT.0.)XSCORE=0. C C ADD NOISE TO SCORE C STD ERROR PROP. TO SCORE ABOVE BASE SD1=XSCORE*SD IF(SD1.LT.SDBASE)SD1=SDBASE C C WRITE(6,9001)SD1 C C GENERATE FINAL SCORE AND CONVERT TO INTEGER CALL NRAND(XSCORE,SD1,X) X=X+.5 S(4)=AINT(X) IF(S(4).LT.0.)S(4)=0. ITMP=I CALL FPOUT2(ITMP,1,FLGS,S,&900) C 1 CONTINUE C C COMPUTE COST OF RUNNING THIS EXPTL GROUP C COMPUTE NO. OF COSTLY CONTROLS NCONT=0 IF(SEXS.NE.0)NCONT=1 IF(YEAR.NE.0)NCONT=NCONT+1 C C COMPUTE NO. OF TEST GROUPS NTESTS=N/NGRP N1=N-NGRP*NTESTS IF(N1.GT.(N/2))NTESTS=NTESTS+1 C C ADD NO. OF TAT'S AND TAQ'S FTAQ=FTAQ.OR.FLGS(3) FTAT=FNACH.OR.FNAFF.OR.FLGS(1).OR.FLGS(2) IF(FTAQ)NTESTS=NTESTS+1 IF(FTAT)NTESTS=NTESTS+1 C C COMPUTE TAT COST XTAT=0. IF(FNACH.OR.FLGS(1))XTAT=1. IF(FNAFF.OR.FLGS(2))XTAT=1.+.8*XTAT C C OVERALL COST XN=N COST=2.*XN+NTESTS*10+XTAT*XN+NCONT*10 CALL FPOUT3(COST) RETURN C 900 STOP '900' C C------------------------------ C C MODEL INITIALIZATION ENTRY MINIT C OPEN(UNIT=IDEV3,ACCESS='SEQIN',FILE=MODNM2,DIRECTORY='4030,11') C READ(IDEV3,2001)NGEFF READ(IDEV3,2001)INSEFF READ(IDEV3,2001)TSKEFA READ(IDEV3,2001)TSKEFB C READ(IDEV3,2001)LENPWR,LPARA READ(IDEV3,2001)LPARB READ(IDEV3,2001)ESXEFA READ(IDEV3,2001)ESXEFB READ(IDEV3,2001)SSXEFF C READ(IDEV3,2002)NACHIN READ(IDEV3,2002)FEARIN C READ(IDEV3,2001)SD,SDBASE C READ(IDEV3,2001)PMALE READ(IDEV3,2002)PNNFR C RETURN C C------------------------------ C 2001 FORMAT(5X,10G5.2) 2002 FORMAT(5X,3G5.5) C END