215 lines
7.6 KiB
Fortran
215 lines
7.6 KiB
Fortran
!
|
|
!=======================================================================
|
|
!
|
|
MODULE FACTORIALS
|
|
!
|
|
! This module provides factorials and other related numbers
|
|
!
|
|
!
|
|
USE ACCURACY_REAL
|
|
USE REAL_NUMBERS, ONLY : ZERO,ONE
|
|
!
|
|
CONTAINS
|
|
!
|
|
!=======================================================================
|
|
!
|
|
FUNCTION FAC(N)
|
|
!
|
|
! This function computes the factorial of n
|
|
!
|
|
! Input parameters:
|
|
!
|
|
! * N : integer
|
|
!
|
|
! Output variables :
|
|
!
|
|
! * FAC : n!
|
|
!
|
|
!
|
|
! Author : D. Sébilleau
|
|
!
|
|
! Last modified : 5 Aug 2020
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
REAL (WP) :: FAC
|
|
REAL (WP) :: FACT(50)
|
|
!
|
|
REAL (WP) :: FLOAT
|
|
!
|
|
INTEGER :: N,K
|
|
INTEGER :: LOGF
|
|
!
|
|
LOGF = 6 !
|
|
!
|
|
IF(N > 50) THEN !
|
|
WRITE(LOGF,10) !
|
|
STOP !
|
|
END IF !
|
|
!
|
|
FACT(1) = ONE !
|
|
!
|
|
DO K = 2, N !
|
|
FACT(K) =FACT(K-1) * FLOAT(K) !
|
|
END DO !
|
|
!
|
|
FAC = FACT(N) !
|
|
!
|
|
10 FORMAT(5X,'<<<<< DIMENSION ERROR IN FAC FUNCTION >>>>>',/, &!
|
|
5X,'<<<<< N SHOULD BE <= 50 OR REDIMENSION >>>>>',//) !
|
|
!
|
|
END FUNCTION FAC
|
|
!
|
|
!=======================================================================
|
|
!
|
|
SUBROUTINE COMBINATORIAL(NMAX,NUMBER,CN)
|
|
!
|
|
! This subroutine computes numbers resulting from combinatorics
|
|
!
|
|
! --> This version if for integers only <--
|
|
!
|
|
!
|
|
!
|
|
! Input variables :
|
|
!
|
|
! NMAX : upper value of n
|
|
! NUMBER : type of numbers computed
|
|
! ---> 'BINOMIAL ' : binomial coefficients
|
|
! ---> 'POCHHAMMER' : Pochhammer coefficients
|
|
! ---> 'STIRLING1S' : signed Stirling numbers of 1st kind
|
|
! ---> 'STIRLING1U' : unsigned Stirling numbers of 1st kind
|
|
! ---> 'STIRLING2N' : Stirling numbers of 2nd kind
|
|
!
|
|
! Output variables :
|
|
!
|
|
!
|
|
! CN : resulting numbers
|
|
!
|
|
!
|
|
! Author : D. Sébilleau
|
|
!
|
|
! Last modified : 31 Jan 2019
|
|
!
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
REAL (WP) :: LG(NMAX),CN(0:NMAX,0:NMAX),X
|
|
!
|
|
REAL (WP) :: EXP,FLOAT
|
|
!
|
|
INTEGER :: NMAX,I,J,K,N
|
|
!
|
|
CHARACTER (LEN = 10) :: NUMBER
|
|
!
|
|
! Initialization of the array
|
|
!
|
|
DO I = 0,NMAX !
|
|
DO J = 0,NMAX !
|
|
CN(I,J) = ZERO !
|
|
END DO !
|
|
END DO !
|
|
!
|
|
IF(NUMBER == 'BINOMIAL ') THEN ! ( N )
|
|
! ! ( K )
|
|
CALL LOG_GAMMA(NMAX,LG) !
|
|
!
|
|
CN(0,0) = ONE !
|
|
DO N = 1,NMAX !
|
|
DO K = 1,NMAX-N !
|
|
X = LG(N)-LG(K)-LG(N-K) !
|
|
CN(N,K) = EXP(X) !
|
|
END DO !
|
|
END DO !
|
|
!
|
|
ELSE IF(NUMBER == 'POCHHAMMER') THEN ! (N)_K
|
|
!
|
|
CALL LOG_GAMMA(NMAX,LG) !
|
|
!
|
|
CN(0,0) = ONE !
|
|
DO N = 1,NMAX !
|
|
DO K = 1,NMAX-N !
|
|
X = LG(N+K)-LG(N) !
|
|
CN(N,K) = EXP(X) !
|
|
END DO !
|
|
END DO !
|
|
!
|
|
ELSE IF(NUMBER == 'STIRLING1U') THEN ! c(N,K)
|
|
!
|
|
CN(0,0) = ONE !
|
|
CN(NMAX,0) = ZERO !
|
|
!
|
|
DO N = 1, NMAX-1 !
|
|
CN(N,0) = ZERO !
|
|
DO K = 1, NMAX-N+1 !
|
|
CN(N+1,K) = FLOAT(N) * CN(N,K) + CN(N,K-1) !
|
|
END DO !
|
|
END DO !
|
|
!
|
|
ELSE IF(NUMBER == 'STIRLING1S') THEN ! s(N,K)
|
|
!
|
|
CN(0,0) = ONE !
|
|
CN(NMAX,0) = ZERO !
|
|
!
|
|
DO N = 1, NMAX-1 !
|
|
CN(N,0) = ZERO !
|
|
DO K = 1, NMAX-N+1 !
|
|
CN(N+1,K) = - FLOAT(N) * CN(N,K) + CN(N,K-1) !
|
|
END DO !
|
|
END DO !
|
|
!
|
|
ELSE IF(NUMBER == 'STIRLING2N') THEN ! S(N,K)
|
|
!
|
|
CN(0,0) = ONE !
|
|
CN(NMAX,0) = ZERO !
|
|
!
|
|
DO N = 1, NMAX-1 !
|
|
CN(N,0) = ZERO !
|
|
DO K = 1,NMAX-N+1 !
|
|
CN(N+1,K) = FLOAT(K) * CN(N,K) + CN(N,K-1) !
|
|
END DO !
|
|
END DO !
|
|
!
|
|
END IF
|
|
!
|
|
END SUBROUTINE COMBINATORIAL
|
|
!
|
|
!=======================================================================
|
|
!
|
|
SUBROUTINE LOG_GAMMA(NMAX,LG)
|
|
!
|
|
! This subroutine computes the logarithm of the Gamma function for
|
|
! integer values (i.e. Log(n!))
|
|
!
|
|
!
|
|
! Input variables :
|
|
!
|
|
! NMAX : upper value of n
|
|
!
|
|
! Output variables :
|
|
!
|
|
! LG : array containing Log(n!)
|
|
!
|
|
! Author : D. Sébilleau
|
|
!
|
|
! Last modified : 5 Aug 2020
|
|
!
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
REAL (WP) :: LG(NMAX)
|
|
!
|
|
REAL (WP) :: LOG,FLOAT
|
|
!
|
|
INTEGER :: NMAX,I,J
|
|
!
|
|
LG(1) = ZERO !
|
|
!
|
|
DO I = 2,NMAX !
|
|
J = I - 1 !
|
|
LG(I) = LG(J) + LOG(FLOAT(J)) !
|
|
END DO !
|
|
!
|
|
END SUBROUTINE LOG_GAMMA
|
|
!
|
|
END MODULE FACTORIALS
|