! !======================================================================= ! MODULE SCATTERING_LENGTH ! USE ACCURACY_REAL ! ! CONTAINS ! ! !======================================================================= ! FUNCTION SCAT_LENGTH_3D(V0,R0,KP,KD,SL_TYPE) ! ! This function computes the s-wave scattering length for various ! types of 3D potentials. It can be considered as the effective radius ! of the potential at zero energy. It is defined as: ! ! a = lim_{k --> 0} - tan(delta_0)/k ! ! where delta_0 is the s-wave phaseshift (l = 0) ! ! Note: the negative scattering length of a repulsive potential ! is always positive. For an attractive potential, it is ! negative if there is no s-bound-state and positive otherwise. ! ! ! References: (1) C. J. Joachain, "Quantum Collision Theory", ! North-Holland (1975) ! (2) F. Calogero, "Variable Phase Approach to ! Potential Scattering" Academic Press (1967) ! (3) X. Chu, C. Garcia-Cely and H. Murayama, ! arXiv:1908.06067v2 [hep-ph] 6 Sep 2019 ! (4) S. Postnikov and M. Prakash, Int. J. Modern Phys. E 22, ! 1330023 (2013) ! ! ! Input parameters: ! ! * V0 : strength/depth of potential in SI (assumed to be an energy) ! * R0 : radius/half-length of potential in SI ! * KP : particle momentum in SI ! * KD : damping momentum in SI ! * SL_TYPE : type of scattering length calculation ! SL_TYPE = 'HSP' --> hard sphere potential ! SL_TYPE = 'ASW' --> attractive square well (without bound state) ! SL_TYPE = 'RSW' --> repulsive square well ! SL_TYPE = 'DSP' --> delta-shell potential ! SL_TYPE = 'AYP' --> attractive Yukawa potential ! SL_TYPE = 'CCO' --> Coulomb cut-off potential ! SL_TYPE = 'HUL' --> Hulthén potential ! ! ! Output parameters: ! ! * SCAT_LENGTH_3D ! ! ! Definition of potentials: ! ! / + inf if r < R0 ! SL_TYPE = 'HSP' : V(r) = < hard sphere ! \ 0 if r > R0 ! ! ! / -|V0| if 0 < r < 2R0 ! SL_TYPE = 'ASW' : V(r) = < (spherical) attractive square well ! \ 0 otherwise (no bound state) = soft sphere ! ! ! / +|V0| if 0 < r < 2R0 ! SL_TYPE = 'RSW' : V(r) = < (spherical) repulsive square well ! \ 0 otherwise = soft sphere ! ! ! ! SL_TYPE = 'DSP' : V(r) = V0 delta(r-R0) delta-shell ! ! ! ! -exp(- KD*r) ! SL_TYPE = 'AYP' : V(r) = V0 ------------- attractive Yukawa ! r ! ! ! V0 1 ! SL_TYPE = 'CCO' : V(r) = ---- --- Theta(R0-r) Coulomb cut-off ! R0 r (computed with R0=1) ! ! ! exp(-KD*R) ! SL_TYPE = 'Hul' : V(r) = V0 KD ------------------ Hulthén ! ( 1-exp(-KD*R) ) ! ! ! ! Author : D. Sébilleau ! ! Last modified : 11 Jun 2020 ! ! USE REAL_NUMBERS, ONLY : ONE,TWO USE CONSTANTS_P1, ONLY : H_BAR,M_E USE EULER_CONST, ONLY : EUMAS USE EXT_FUNCTIONS, ONLY : DBESJ0,DBESJ1,DPSIPG ! IMPLICIT NONE ! CHARACTER (LEN = 3) :: SL_TYPE ! REAL (WP), INTENT(IN) :: V0,R0,KP,KD REAL (WP) :: SCAT_LENGTH_3D REAL (WP) :: U0,KE,R,K0,G REAL (WP) :: J0,J1,J2,XX REAL (WP) :: PG1,PG2,ETA ! REAL (WP) :: SQRT,ABS,TAN,TANH ! ! Potential strength in reduced units --> = square momentum KO^2 ! U0 = TWO * M_E * V0/ (H_BAR * H_BAR) ! K0 = SQRT(ABS(U0)) ! G = ABS(U0 * R0) ! ! ! Effective momentum from energy conservation ! ! U0 > 0 for repulsive KE = SQRT(ABS(KP * KP -U0)) ! U0 < 0 for attractive ! R = R0 + R0 ! potential length for SW ! IF(SL_TYPE == 'HSP') THEN ! SCAT_LENGTH_3D = R0 ! ELSE IF(SL_TYPE == 'ASW') THEN ! negative SCAT_LENGTH_3D = R * (ONE - TAN(KE * R)/(KE * R)) ! ref. 1 eq. (4.157) ELSE IF(SL_TYPE == 'RSW') THEN ! SCAT_LENGTH_3D = R * (TANH(KE * R)/( KE * R) - ONE) ! positive ELSE IF(SL_TYPE == 'AYP') THEN ! SCAT_LENGTH_3D = U0 / (KD * KD * KD) ! ELSE IF(SL_TYPE == 'DSP') THEN ! SCAT_LENGTH_3D = R0 * G / (G - ONE) ! ref. 4 eq. (56) ELSE IF(SL_TYPE == 'CCO') THEN ! XX = TWO * DSQRT(- U0) ! J0 = DBESJ0(XX) ! J1 = DBESJ1(XX) ! J2 = - J0 + TWO * J1 / XX ! recurrence ! SCAT_LENGTH_3D = - J2 / (U0 * J0) ! ref. 2 eq. (5a) ELSE IF(SL_TYPE == 'HUL') THEN ! ETA = SQRT(U0 * M_E / KD) ! PG1 = DPSIPG(ONE+ETA,0) ! PG2 = DPSIPG(ONE-ETA,0) ! ! SCAT_LENGTH_3D = (PG1 + PG2 + EUMAS + EUMAS) / KD ! ref. 3 eq. (A21) END IF ! ! END FUNCTION SCAT_LENGTH_3D ! END MODULE SCATTERING_LENGTH