!
!=======================================================================
!
MODULE DIGAMMA_FUNCTION
!
!  This module provides different subroutine/functions 
!    to compute the Digamma function, namely:
!
!
!
!   3) SUBROUTINE PSI(X,PS)                 <-- x real
!
!
      USE ACCURACY_REAL
!
CONTAINS
!
!=======================================================================
!
      SUBROUTINE PSI(X,PS)
!
!*********************************************************************72
!
! PSI computes the Psi function.
!
!  Licensing:
!
!    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
!    they give permission to incorporate this routine into a user program 
!    provided that the copyright is acknowledged.
!
!  Modified:
!
!    22 July 2012
!
!  Author:
!
!    Shanjie Zhang, Jianming Jin
!
!  Reference:
!
!    Shanjie Zhang, Jianming Jin,
!    Computation of Special Functions,
!    Wiley, 1996,
!    ISBN: 0-471-11963-6,
!    LC: QA351.C45.
!
!  ============================================
!
!       Purpose: Compute Psi function
!
!       Input :  X  --- Argument of psi(x)
!
!       Output:  PS --- psi(x)
!
!  ============================================
!
!
!                                     Last modified (DS) :  1 Sep 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,TEN, & 
                                      HALF,INF
      USE PI_ETC,              ONLY : PI
!
      IMPLICIT NONE
!
      INTEGER                ::  K,N
!
      REAL (WP), INTENT(IN)  ::  X
!
      REAL (WP), INTENT(OUT) ::  PS
!
      REAL (WP)              ::  A1,A2,A3,A4,A5,A6,A7,A8
      REAL (WP)              ::  S,X2,XA
!
      REAL (WP), PARAMETER   ::  EL = 0.5772156649015329E+00_WP
!
      XA = DABS(X)                                                  !
      S  = ZERO                                                     !
!
      IF(X == INT(X) .AND. X <= ZERO) THEN                          !
!
        PS = INF                                                    !
        RETURN                                                      !
!
      ELSE IF(XA == INT(XA)) THEN                                   !
!
        N = INT(XA)                                                 !
        DO K = 1, N - 1                                             !
          S = S + ONE / K                                           !
        END DO                                                      !
        PS = - EL + S                                               !
!
      ELSE IF(XA + HALF == INT(XA + HALF)) THEN                     !
!
        N =  INT(XA - HALF)                                         !
        DO K = 1, N                                                 !
          S = S + ONE / (TWO * K - ONE)                             !
        END DO
        PS = - EL + TWO * S - 1.386294361119891E+00_WP              !
!
      ELSE                                                          !
!
        IF(XA < TEN) THEN                                           !
          N = 10 - INT(XA)                                          !
          DO K = 0, N - 1                                           !
            S = S + ONE / (XA + K)                                  !
          END DO                                                    !
          XA = XA + N                                               !
        END IF                                                      !
!
        X2 = ONE / (XA * XA)                                        !
        A1 = -0.8333333333333E-01_WP                                !
        A2 =  0.83333333333333333E-02_WP                            !
        A3 = -0.39682539682539683E-02_WP                            !
        A4 =  0.41666666666666667E-02_WP                            !
        A5 = -0.75757575757575758E-02_WP                            !
        A6 =  0.21092796092796093E-01_WP                            !
        A7 = -0.83333333333333333E-01_WP                            !
        A8 =  0.4432598039215686E+00_WP                             !
!
        PS = DLOG(XA) - HALF / XA + X2 * (((((((                  & !
            A8  * X2                                              & !
          + A7) * X2                                              & !
          + A6) * X2                                              & !
          + A5) * X2                                              & !
          + A4) * X2                                              & !
          + A3) * X2                                              & !
          + A2) * X2                                              & !
          + A1)                                                     !
        PS = PS - S                                                 !
!
      END IF                                                        !
!
      IF(X < ZERO) THEN                                             !
        PS = PS - PI * DCOS(PI * X) / DSIN(PI * X) - ONE / X        !
      END IF                                                        !
!
      RETURN                                                        !
!
      END SUBROUTINE PSI
!
END MODULE DIGAMMA_FUNCTION