Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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