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