C IMPRINTING SIMULATION SUBROUTINE C OCT. 14, 1971 C BOB STOUT, PROGRAMMER C DON RAJECKI, SIMULATION DESIGNER (FALL, 1970) C MODIFIED DRASTICALLY BY BOB STOUT, AUGUST, 1972 C C SUBROUTINE MODEL(N,NCOND,*) IMPLICIT INTEGER*4 (O) INTEGER*4 LINE COMMON /IO/IDEV(4),ODEV1,ODV(3),LINE(80) C INTEGER*4 SI(12), SF(12) INTEGER*4 IV(12) REAL*4 FV(12) LOGICAL*4 FLGS(12) COMMON /VARS1/IV, FV, SI, SF, FLGS C INTEGER*4 REAR,TARG,TEST,AROUS,INDUCT,WALK,AGE EQUIVALENCE (REAR,IV(1)), (TARG,IV(2)), (TEST,IV(3)), 1 (AROUS,IV(4)), (INDUCT,IV(4)), (WALK,IV(6)), (AGE,IV(7)) C C TABLE OF AGE CATEGORIES INTEGER*4 AGETBL(6) !! DATA AGETBL/8,12,16,20,30,48/ C C AROLRN CONTROLS THE EFFECT OF AROUSAL ON LEARNING RATE. C (1-AROLRN(AROUS)) IS THE PROPORTION OF THE DISTANCE TOWARD ASYMP- C TOTE THAT THE ANIMAL WILL GO IN A GIVEN TRIAL IN WHICH IMPRINT- C ING IS TAKING PLACE. REAL LRNPAR, AROLRN(5) !! DATA AROLRN/.75, .65, .60, .55, .40/ C C AROUSAL-AGE INTERACTION TABLE C THE AROAGE TABLE CONTROLS THE EFFECT OF AROUSAL AND AGE ON PIMP, C THE PROBABILITY OF BEGINNING IMPRINTING ON A GIVEN TRIAL. IT C IS ALSO USED TO HELP DETERMINE THE ASYMPTOTE OF THE LEARNING C CURVE (A SEPARATE TABLE REALLY SHOULD BE USED, BUT THIS WAY IS C EASIER). REAL*4 AROAGE(5,6) !! DATA AROAGE/ .30, .55, .85, .92, .95, !! 1 .24, .48, .80, .88, .92, !! 2 .18, .40, .60, .70, .88, !! 3 .12, .30, .50, .65, .85, !! 4 .09, .20, .30, .45, .55, !! 5 .07, .10, .15, .30, .45/ C C IF WALK=MATCHED, THE STANDARD ERRORS FOR GENERAL NOISE AND C LEARNING ASYMPTOTE INDIVIDUAL DIFFERENCES ARE REDUCED REAL*4 WALKEF(2) !! DATA WALKEF/1.0, .70/ C C ISOLATED REARING INCREASES IMPRINTING OVERALL REAL*4 REAREF(2) !! DATA REAREF/1.0, 0.5/ C C ASSORTED OTHER STUFF REAL*4 NOISE,DMISS(6),DATA(6),LRNSE C BASE IS THE MEAN IMPRINTING SCORE FOR ANIMALS WHICH HAVE NOT YET C BEGUN TO IMPRINT C GNSD IS THE STANDARD DEVIATION OF THE GENERAL MEASUREMENT ERROR C ASIGMA IS THE UPPER BOUND OF THE STANDARD DEVIATION OF LEARNING C ASYMPTOTES C DMISS IS PURELY FOR THE BENEFIT OF FPOUT C LRNSE CONTROLS THE STANDARD ERROR DUE TO VARIATIONS IN STRENGTH C OF LEARNING !! DATA BASE/1./, GNSD/1./, ASIGMA/4./, DMISS/6*-1./, LRNSE/4./ C DOUBLE PRECISION MODNM1,MODNM2,MODNM3 COMMON /DATANM/ MODNM1,MODNM2,MODNM3 DATA MODNM1/'IMPT.DAT'/ ,MODNM2/'IMPT3.DAT'/,MODNM3/'IMPT.BIN'/ C DATA AGETBL/8,12,16,20,30,48/ DATA AROLRN/.75, .65, .60, .55, .40/ DATA AROAGE/ .30, .55, .85, .92, .95, 1 .24, .48, .80, .88, .92, 2 .18, .40, .60, .70, .88, 3 .12, .30, .50, .65, .85, 4 .09, .20, .30, .45, .55, 5 .07, .10, .15, .30, .45/ DATA WALKEF/1.0, .70/ DATA REAREF/1.0, 0.5/ DATA BASE/1./, GNSD/1./, ASIGMA/4./, DMISS/6*-1./, LRNSE/4./ NCOND=NCOND!DEC-10 FORTRAN COMPILER BUG REQUIRES THIS C C------------------------------ C C SET UP OUTPUT SUBROUTINE DO 10 I=1,6 10 FLGS(I)=I.LE.TEST CALL FPOUT1(FLGS,DMISS,&999) C C SIMULATE THE SUBJECTS LRNPAR=AROLRN(AROUS) DO 1 I=1,N IMP=0 LTRIAL=0 C C IF AGE IS RANDOM, SELECT AN AGE IF(SI(7).NE.0)CALL URAND2(16,30,AGE) C C COMPUTE AGE CATEGORY DO 2 IAGE=1,6 IF(AGE.LE.AGETBL(IAGE))GO TO 3 2 CONTINUE C C PROBABILITY OF BEGINNING IMPRINTING IS A FUNCTION OF AROUSAL C AND AGE 3 PIMP=AROAGE(AROUS,IAGE) C C LEARNING ASYMPTOTE IS A FUNCTION OF AROUSAL, AGE, REARING, AND C INDIVIDUAL DIFFERENCES RAA=REAREF(REAR)*AROAGE(AROUS,IAGE) ASYMP=40.*RAA C INDIVIDUAL DIFFERENCES HAVE STD. ERROR PROPORTIONAL TO ASYMPTOTE SE=ASIGMA*WALKEF(WALK)*RAA CALL NRAND(0.,SE,NOISE) ASYMP=ASYMP+NOISE IF(ASYMP.LT.0.)ASYMP=0. C C C SIMULATE EACH TEST DO 4 J=1,TEST DV=0. C C IF S HAS NOT STARTED IMPRINTING YET, IT HAS A CHANCE NOW IF(IMP.EQ.0)CALL BINOM(1,PIMP,IMP) C IF ANIMAL HAS NOT STARTED TO IMPRINT, SKIP NEXT SECTION IF(IMP.EQ.0)GO TO 5 C C LEARNING MODEL IS SIMPLE LINEAR OPERATOR LTRIAL=LTRIAL+1 DV=ASYMP*LRNPAR**LTRIAL C GENERATE NOISE PROPORTIONAL TO HEIGHT OF ASYMPTOTE AND INVERSELY C PROPORTIONAL TO STRENGTH OF LEARNING SE=LRNSE*RAA*(DV/ASYMP) CALL NRAND(0.,SE,NOISE) DV=ASYMP-DV+NOISE C C ADD BASE RATE AND GENERAL NOISE C GENERAL NOISE DEPENDS ON WALK 5 SE=WALKEF(WALK)*GNSD CALL NRAND(0.,SE,NOISE) DV=DV+BASE+NOISE C ROUND ALL FIGURES TO NEAREST TENTH AND CUT OFF BELOW 0 DV=10.*DV+.5 IX=AINT(DV) DV=IX DV=0.1*DV IF(DV.LT.0.)DV=0. 4 DATA(J)=DV ITMP=I CALL FPOUT2(ITMP,1,FLGS,DATA,&999) 1 CONTINUE C C FINISH OUTPUT CALL FPOUT3(0.) RETURN C C OUTPUT ERROR 999 STOP '999' C C ENTRY MINIT RETURN C END