PROGRAM CMP
C
C*  This program computes scores, analytic derivative and finite difference
C*  derivatives.
C
	REAL	P(3), B(3)
	REAL    scorcp(3), scorcb(3), u (3)
	db = .02
	dp = .02

	WRITE (6,*) ' Enter F, H, O, N'
	READ (5,*) frcs, hits, obs, nn
C*
	alpha = obs / FLOAT (nn)
	bias = frcs / obs
        pod = hits / obs
        rn = FLOAT (nn)
C
	WRITE (6,*) ' B, P, alpha = ', bias, pod, alpha
C
C*  DHDA Bias adjusted eq. threat score.
C
	P(1) = pod - dp
	P(2) = pod
	P(3) = pod + dp
	B(1) = bias - db
	B(2) = bias
	B(3) = bias + db
	DO i = 1, 3
	    u(i) = - ALOG ( 1. - P (i) ) / ( B(i) - P(i) )
	    ucb = - ALOG ( 1. - P (i) ) / ( B(2) - P(i) )
	    ucp = - ALOG ( 1. - P (2) ) / ( B(i) - P(2) )
	    wcb = WEW_B ( ucb, eee )
	    wcp = WEW_B ( ucp, eee )
	    ddcb = 1. - alpha + wcb / ucb
	    ddcp = 1. - alpha + wcp / ucp
	    scorcb (i) = (1. - alpha - wcb/ucb )/ddcb
	    scorcp (i) = (1. - alpha - wcp/ucp )/ddcp
	    If ( i .eq. 2 ) THEN
		wu = WEW_B (u(i),eee)
	        dd = 1. - alpha + wu / u(i)
	        scor = (1. - alpha - wu/u(i))/dd
		ddd = ALOG(1.-P(i))*dd*dd*(1.+wu)
		dsdb = 2.*(1. - alpha) * wu * wu / ddd
		dsdp = -dsdb * (u(i)*(1.-P(i)) + 1.)
		dsdp = dsdp / (u(i)*(1.-P(i)))
		rncpr = ALOG ( 1. - P(i) )
		ddcpr = rncpr - (B(i)-P(i))/(1.-P(i))
		acpr = rncpr / ddcpr
	    END IF
	END DO
	fdsdb = (scorcp(3) - scorcp(1)) / (2.*db)
	fdsdp = (scorcb(3) - scorcb(1)) / (2.*dp)
	cprb1 = ALOG(1.-P(2))/( ALOG(1.-P(2)) - 1. )
C*
	WRITE (6,*) ' DHDA Bias adjusted Thrt Score = ', scor
	WRITE (6,*) ' Analytic dsdb = ', dsdb
	WRITE (6,*) ' Finite diff dsdb = ', fdsdb
	WRITE (6,*) ' Analytic dsdp = ', dsdp
	WRITE (6,*) ' Finite diff dsdp = ', fdsdp
	WRITE (6,*) ' CPR = ', -dsdb/dsdp
	WRITE (6,*) ' Analytic CPR = ', acpr
	WRITE (6,*) ' CPR (B=1) = ', cprb1
C*
	STOP
	END
C========================================================================
C
C*	The following function inverts w*exp(w).
C
      REAL FUNCTION WEW_B ( X, EN )
	  
C  Code taken from http://www.netlib.org/toms/443
C
C  ITERATIVE SOLUTION OF X = W * EXP ( W ) WHERE X IS GIVEN.
C  (NOVEMBER 1970)
C  (REVISED - SEPTEMBER 1971)
C  VERSION B -- MAXIMUM RELATIVE ERROR 3.E-7.
C
C  INPUT PARAMETER:
C    X  ARGUMENT OF W(X)
C
C  OUTPUT PARAMETERS:
C    WEW  THE DESIRED SOLUTION.
C    EN   THE LAST RELATIVE CORRECTION TO W(X).
C
C  SET CONSTANTS...
C     .. Scalar Arguments ..
      REAL EN,X,F
C     ..
      REAL FLOGX,TEMP,WN,Y,ZN
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC LOG
C     ..
C  COMPUTE INITIAL GUESS...
      FLOGX = LOG ( X )
      IF ( X - .7385 ) 30, 30, 40
30    WN = X*(3.0 + 4.0*X)/(3.0 + X*(7.0 + 2.5*X))
      GO TO 50
40    WN = FLOGX - 24. * ((FLOGX+2.) * FLOGX-3.) /
     +     (( .7 * FLOGX + 58. ) * FLOGX + 127. )
50    CONTINUE
C
C  ITERATION ONE...
      ZN = FLOGX - WN - LOG ( WN )
      TEMP = 1. + WN
      Y = 2. * TEMP * ( TEMP + ZN/1.5 ) - ZN
      EN = ZN * Y / ( TEMP * ( Y - ZN ) )
      WN = WN * ( 1. + EN )
C
C  RETURN...
      WEW_B = WN
      RETURN
      END