Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0093/schiz.for
There are no other files named schiz.for in the archive.
C     MODEL SUBROUTINE FOR SCHIZ SIMULATION
C     OCTOBER 19, 1971
C     BOB STOUT, PROGRAMMER
C     D. MALIN, SIMULATION DESIGNER
C     MODIFIED AUGUST, 1972 BY BOB STOUT
C     MODIFIED JANUARY, 1973 BY BOB STOUT
C
C
      SUBROUTINE MODEL(N,NCOND,*)
C
      INTEGER*4 SI(12),SF(12), OVNAM
      INTEGER*4 IV(12), SINK
      LOGICAL*4 COSTPT, DATOUT
      REAL*4 FV(12)
      COMMON /VARS1/IV,FV,SI,SF
      COMMON /IO1/NOV,SINK,OVNAM(8,6),COSTPT,DATOUT
C
      INTEGER*4 REL,ADOPT,DIAG,SEXI,SEXS
      EQUIVALENCE (INDEX,IV(1)),(REL,IV(2)),(ADOPT,IV(3)),
     1 (DIAG,IV(4)),(SEXI,IV(7)),(SEXS,IV(8)),(METHOD,IV(6))
C
      REAL*4 METH(2), NOISE
C     METH CONTAINS THE MAIN EFFECT PARAMETERS FOR METHOD
C     BASE IS THE BASE RATE OF SCHIZ IN THE GENERAL POPULATION
C     DMINT IS THE COEFFICIENT FOR THE DIAG-METHOD INTERACTION
!      DATA METH/0.15, 0.0/, BASE/.015/, DMINT/10./
C
C     SEXEFF CONTAINS PARAMETERS FOR THE SEX EFFECT.  EFFECT DEPENDS
C     ONLY ON WHETHER SEXI(INDEX S)=SEXS(ACTUAL S).  FOR SEXI=SEXS
C     SEXEFF(2) IS USED, OTHERWISE SEXEFF(1).
      REAL*4 SEXEFF(2)
!      DATA SEXEFF/0.8, 1.2/
C
C     RATES CONTAINS THE SCHIZ RATES FOR VARIOUS RELATIVES: 1=UNREL,
C     2=AUNTUNCL, 3=COUSIN, 4=SIBLING, 5=FRATTWIN, 6=IDTWIN, 7=PARENT,
C     8=CHILD, 9=NIECNEPH
      REAL*4 RATES(9)
!      DATA RATES/0., .05, .04, .15, .14, .50, .18, .18, .04/
C
C     DIAGEF AND ADOEFF CONTAIN THE MAIN EFFECT PARAMETERS FOR STRICT-
C     NESS OF DIAGNOSIS AND ADOPT
      REAL*4 DIAGEF(2), ADOEFF(3)
!      DATA DIAGEF/0., 0.6/, ADOEFF/1.0, .65, 0./
C  
      DOUBLE PRECISION MODNM1,MODNM2,MODNM3
      COMMON /DATANM/ MODNM1,MODNM2,MODNM3
      DATA METH/0.15, 0.0/, BASE/.015/, DMINT/10./
      DATA SEXEFF/0.8, 1.2/
      DATA RATES/0., .05, .04, .15, .14, .50, .18, .18, .04/
      DATA DIAGEF/0., 0.6/, ADOEFF/1.0, .65, 0./
      DATA MODNM1/'SCHIZ.DAT'/,MODNM2/'SCHIZ3.DAT'/,MODNM3/'SCHIZ.BIN'/
C
C------------------------------
C
	NOISE=NOISE!DEC-10 BUG REQUIRES THIS
	NCOND=NCOND!DITTO
      XN=N
      SEX=0.
C     COMPUTE OVERALL SEX EFFECT
      IF(SEXI.EQ.0 .OR. SEXS.EQ.0)GO TO 2
C
C     IT ONLY MATTERS WHETHER SEXI=SEXS, NOT WHAT THE SEXES ARE
      SEX=SEXEFF(1)
      IF(SEXI.EQ.SEXS)SEX=SEXEFF(2)
C     IDENTICAL TWINS ALWAYS HAVE SAME SEX
 2    IF(REL.EQ.6)SEX=SEXEFF(2)
      IF(SEX.GT.0.01)GO TO 3
C
C     SEX IS RANDOMIZED--COMPUTE AVERAGE EFFECT
      CALL BINOM(N,.5,I)
      XI=I
      SEX=XI*SEXEFF(1)+(XN-XI)*SEXEFF(2)
      SEX=SEX/XN
C
C------------------------------
C
C     ***** THE MODEL *****
C
C     SKIP THE MODEL IF INDEX=NONSCHIZ OR REL=UNREL
 3    IF(INDEX.EQ.2 .OR. REL.EQ.1)GO TO 4
C
C     HEREDITY-REARING FACTORS
      P1=RATES(REL)*ADOEFF(ADOPT)
C
C     SEX LINKAGE FACTOR
      P1=P1+(SEX-1.)*P1*(1.-P1)
C
C     ADD IN BASE RATE
      P1=P1+BASE*(1.-P1)
C
C     PUT IN GROSS RATE INFLATION FACTORS--METHOD AND DIAGNOSIS
      P2=1.-P1
      P2=P1*P2*P2
      P1=P1+(METH(METHOD)+DIAGEF(DIAG)+DMINT*DIAGEF(DIAG)*METH(METHOD))
     1	*P2
C
C     NO. OF SUBJECTS DIAGNOSED SCHIZ IS BINOMIAL RV
 5    CALL BINOM(N,P1,NSCHIZ)
C
C     PRINT RESULTS
      WRITE(SINK,1001)NSCHIZ
      RETURN
C
C     SIMULATE A SAMPLE FROM THE GENERAL POPULATION
 4    P1=BASE*(1.+DIAGEF(DIAG))
      GO TO 5
C
 1001 FORMAT(1H0,5X,I4,' SUBJECTS DIAGNOSED SCHIZOPHRENIC.')
C
C------------------------------
C
      ENTRY MINIT
      RETURN
      END