Moderator functions from original Fortran CHOP by T.G. Perring

mod_funs.for

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     SUBROUTINE TIKEDA(S1,S2,B1,B2,EMOD,EI,TAUSQR)
C     =============================================
C  Works out the variance of the moderator pulse for a moderator
C  described by an Ikeda-Carpenter time pulse. Answer in sec**2.
C
C     S1  constant in expression for macroscopic xsect        R*8
C        of moderator. Units: m**-1
C     S2  gradient of wavelength**2 in expression for xsect   R*8
C        Units: (m*Ang)**-1
C     B1  inverse time constant for moderator storage term    R*8
C        in the range E<130 meV. Units: mms**-1
C     B2  inverse time constant for E>130 meV                 R*8
C        Units: mms**-1
C   EMOD  swap over energy from chi squared to storage        R*8
C        term (meV)
C     EI  energy of neutrons (meV)                            R*8
C TAUSQR  value of the variance of Ikeda/Carpenter            R*8
C        function at the specified energy. Returned
C        in sec**2
C
C ENTRY
C =====
C   All must be provided, except for TAUSQR which is supplied
C  by the the routine.
C
C EXIT
C ====
C   All unchanged except TAUSQR which is now assigned.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 
      SUBROUTINE TIKEDA(S1,S2,B1,B2,EMOD,EI,TAUSQR)
	DOUBLE PRECISION s1, s2, b1, b2, emod, ei, tausqr, sig, a, b, r

      SIG=SQRT( S1*S1 + S2*S2*81.8048/EI )
      A = 4.37392D-4 * SIG * SQRT(EI)
        IF (EI .GT. 130.0) THEN
      B=B2
        ELSE
      B=B1
        ENDIF

      R=EXP(-EI/EMOD)

      TAUSQR=3.0/(A*A) + R*(2.0-R)/(B*B)

C  variance currently in mms**2. Convert to sec**2
      TAUSQR=TAUSQR*1.0D-12

      RETURN
      END



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     SUBROUTINE TCHI(DELTA,EI,TAUSQR)
C
C  Works out the variance of the moderator pulse for a
C  Chi**2 function. Answer in S**2.
C
C     DELTA    characteristic thickness of moderator. It        R*8
C             is the distance a neutron of energy EI covers
C             in a time equal to the FWHH of
C             the moderator time pulse. It is a constant for
C             the Chi**2 function. Is 28mm typicaly. DELTA
C             is needed in metres.
C     EI       energy of neutrons (meV)                         R*8
C     TAUSQR   value of the variance of Chi**2 function         R*8
C             at the specified energy. Returned in sec**2
C
C ENTRY
C =====
C  DELTA,EI are needed.
C  TAUSQR set by the program
C
C EXIT
C ====
C  DELTA,EI unchanged.
C  TAUSQR assigned.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE TCHI(DELTA,EI,TAUSQR)
      DOUBLE PRECISION delta, ei, tausqr, vel
        VEL=437.392*SQRT(EI)
        TAUSQR=( (DELTA/1.96) / VEL )**2
      RETURN
      END


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     SUBROUTINE TCHI_2(DELTA_0,DELTA_G,EI,TAUSQR)
C
C  Works out the variance of the moderator pulse for a
C  Chi**2 function with an energy dependant width of the form:
C
C     DELTA  =  DELTA_0  +  DELTA_G * SQRT(EmeV)
C
C   where:
C
C     DELTA    characteristic thickness of moderator. It
C             is the distance a neutron of energy EI covers
C             in a time equal to the FWHH of
C             the moderator time pulse. It is a constant for
C             the Chi**2 function. Is 28mm typicaly.
C
C  Answer in S**2.
C
C     DELTA_0  in metres                                        R*8
C     DELTA_G  in metres/(meV)**0.5                             R*8
C     EI       energy of neutrons (meV)                         R*8
C     TAUSQR   value of the variance of Chi**2 function         R*8
C             at the specified energy. Returned in sec**2
C
C ENTRY
C =====
C  DELTA_0,DELTA_G,EI are needed.
C  TAUSQR set by the program
C
C EXIT
C ====
C  DELTA_0,DELTA_G,EI unchanged.
C  TAUSQR assigned.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE TCHI_2(DELTA_0,DELTA_G,EI,TAUSQR)
      DOUBLE PRECISION delta_0, delta_g, ei, tausqr, vel
        VEL=437.392*SQRT(EI)
        TAUSQR=( ( (DELTA_0+DELTA_G*SQRT(EI))/1.96) / VEL )**2
      RETURN
      END