SUBROUTINE MODEL(NDATA,NCOND,*) C C SIMULATION OF CONDITIONED VERBAL DOMINANCE C WRITEN BY RICHARD JOHNSON C EXXON CORP. C ADAPTED FOR USE WITH MESS BY ROY F TOUZEAU & JAMES R ULLRICH C UNIVERSITY OF MONTANA C MISSOULA, MONTANA 59801 C PHONE (406) 243-4662 C C C STUFF TO INTERFACE WITH SYSTEM INTEGER*4 LINE,SI,SF,REINF INTEGER*4 ODEV1,ODV REAL*4 DMISS(6) LOGICAL*4 FLGS !! DATA FLGS/12*.FALSE./, DMISS/6*-1./ C COMMON /IO/ IDEV(4),ODEV1,ODV(3),LINE(80) COMMON /VARS1/ IV(12),FV(12),SI(12),SF(12),FLGS(12) DIMENSION NCHOS(6), CONVR(2), RLIM(2,2) EQUIVALENCE (IDEV3,IDEV(3)), (REINF,IV(1)), (NCHOS(1),IV(2)), * (RLIM(1,1),FV(1)), (CONVR(1),FV(5)) C C EFFECT MAGNITUDES TABLES READ BY MINIT DIMENSION LIMV(6), CUMDS(6,10), VAR(6,10), IPTS(2,20) DIMENSION VLIM(2,2) C DIMENSION VAL(6) C C--------------------------------- C DOUBLE PRECISION MODNM1,MODNM2,MODNM3 COMMON /DATANM/ MODNM1,MODNM2,MODNM3 DATA MODNM1/'CSDM.DAT'/, MODNM2/'CSDM3.DAT'/,MODNM3/'CSDM.BIN'/ DATA FLGS/12*.FALSE./, DMISS/6*-1./ NCOND=NCOND!A DEC-10 FORTRAN-TEN BUG REQUIRES THIS C C************************************************************ C C SET UP FOR OUTPUT FLGS(1)=.TRUE. DMISS(1)=0.0 CALL FPOUT1(FLGS,DMISS,&900) C C CHECK ORDER OF LIMITS ON IQ VARIABLE DO 43 I=1,2 43 IF(RLIM(I,1)-RLIM(I,2).LE.0.0) GO TO 45 WRITE(ODEV1,44) 44 FORMAT('0ILLEGAL VALUES ON IQ VARIABLE'/) RETURN 1 C INM=0 INV=0 IDCST=0 C 45 PDIFF=0.0 IF(REINF.EQ.1) GO TO 56 C C MAKE SURE LENGTH OF SESSION AND RATE OF REINF ARE WITHIN LIMITS VALM = 4.0 IF(CONVR(2).LE.4.0) VALM= CONVR(2) VALL = 120.0 IF(CONVR(1).LE.120.0) VALL = CONVR(1) C C PDIFF IS THE EFFECT DUE TO RATE OF REINF AND SESSION LENGTH PDIFF=VALL*VALM/(VALL*VALM+200.) C C----------------------------------- C C SIMULATE NDATA SUBJECTS 56 DO 83 IT=1,NDATA CALL NRAND(SAM,SER,DATA) C C GET EFFECTS OF VARIABLES DO 61 I=1,6 IZ=NCHOS(I) IF(NCHOS(I).NE.0) GO TO 60 CALL URAND(YFL) DO 58 II=1,10 IF(CUMDS(I,II).GT.YFL) GO TO 59 58 CONTINUE 59 IZ=II 60 VAL(I)=VAR(I,IZ) 61 CONTINUE C C EFFECT OF IQ RANGES SD =16. AIQ=120. IF((RLIM(2,2)-RLIM(2,1)-80.0).GE.0.0) GO TO 69 66 CALL NRAND(AIQ,SD,SIQ) INM=INM+1 IF(SIQ.LT.RLIM(2,1)) GO TO 66 IF(SIQ.GT.RLIM(2,2)) GO TO 66 AIQ=SIQ 69 CALL NRAND(AIQ,SD,SIQ) INV=INV+1 IF(SIQ.LT.RLIM(1,1)) GO TO 69 IF(SIQ.GT.RLIM(1,2)) GO TO 69 71 CALL NRAND(AIQ,SD,OIQ) IF(OIQ.LT.RLIM(1,1)) GO TO 71 IF(OIQ.GT.RLIM(1,2)) GO TO 71 C C PUT EFFECTS TOGETHER VALT=(SIQ-OIQ)/85. DATA=DATA+VAL(3)+VAL(2)*VAL(4)+(1.-DATA)*VALT PROB = 1.0-DATA IF(DATA-0.5.LT.0) PROB = DATA PROB=PROB*PDIFF*VAL(6)*VAL(1)-VAL(5) IF (PROB.LT.0) PROB = 0.0 DATA=DATA+PROB IF(DATA.GE.0.0.AND.DATA.LE.1.0) GO TO 82 IF(DATA.LE.0.0) DATA=0.0 IF (DATA.GE.1.0) DATA=1.0 C C TRANSFORMATION FROM PROB OF RESPONSE TO DOM SCORES 82 DATA=INT(DATA*20.0+.5) ITTMP=IT CALL FPOUT2(ITTMP,1,FLGS,DATA,&900) 83 CONTINUE C C-------------------------------- C C CALCULATION OF THE EXPERIMENT COST C DO 97 I=1,6 IF(NCHOS(I).NE.0) IDCST=IDCST+1 97 CONTINUE IF(.NOT.IDCST) GO TO 100 XDCST=IPTS(1,IDCST) IF(CONVR(1).NE.1.0) GO TO 100 TCST=0. GO TO 101 100 TCST=CONVR(1 )/120.*15. 101 IF(CONVR(2).NE.0.2) GO TO 103 RCST=0.0 103 RCST=CONVR(2)/4.*15. INCST=NDATA IF(RLIM(1,2).NE.(RLIM(1,1)+80.0).OR.RLIM(2,2).NE.(RLIM(2,1) * +80.0)) INCST=NDATA+(INM-NDATA)/2+(INV-NDATA)/2 IR=INCST/5 JSCAL = IR/20 IF (IR.GT.20) IR = MOD(IR,20) IPCST=IPTS (2,IR) + JSCAL*IPTS(2,20) IPH=IPTS (2,IR+1) + JSCAL*IPTS(2,20) XNTRP=NDATA-5*IR XNCST=XNTRP/5.*(IPH-IPCST)+IPCST COST=XNCST+TCST+RCST+XDCST C CALL FPOUT3(COST) C 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 C READ (IDEV3, 8 )((CUMDS(I,J),J=1,10),I=1,6) READ(IDEV3, 8 )((VAR(I,J),J=1,10),I=1,6) READ (IDEV3, 9) LIMV,((VLIM(I,J),J=1,2),I=1,2) READ(IDEV3,10 )MDAT,SER,SAM READ (IDEV3, 11 )((IPTS(I,J),J=1,20),I=1,2) C RETURN C C--------------------------- C 8 FORMAT (10F8.0) 9 FORMAT (6I1,8F3.0) 10 FORMAT (I3,2F10.0) 11 FORMAT (40I2) C END