! !======================================================================= ! 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