Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0093/impt.for
There are no other files named impt.for in the archive.
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