Add files via upload

Author: rweed

License.txt

@@ -0,0 +1,242 @@
+
+!Copyright (C) 2021 Richard Weed.
+!All rights reserved.
+
+!Redistribution and use in source and binary forms, with or without 
+!modification, are permitted provided that the following conditions are met:
+
+!1. Redistributions of source code, in whole or in part, must retain the  
+!above copyright notice, this list of conditions and the following 
+!disclaimer.
+
+!2. Redistributions in binary form, in whole or in part, must reproduce the 
+!above copyright notice, this list of conditions and the following disclaimer 
+!in the documentation and/or other materials provided with the distribution.
+
+!3. The names of the contributors may not be used to endorse or promote from 
+!products derived from this software without specific prior written 
+!permission.
+
+!4. Redistributions of this software, in whole or in part, in any form, 
+!must be freely available and licensed under this original License. The 
+!U.S. Government may add additional restrictions to their modified and 
+!redistributed software as required by Law. However, these restrictions 
+!do not apply to the original software distribution.
+ 
+!5. Redistribution of this source code, including any modifications, may 
+!not be intentionally obfuscated.
+
+!6. Other code may make use of this software, in whole or in part, without 
+!restriction, provided that it does not apply any restriction to this 
+!software other than outlined above.
+
+!THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+!IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+!THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS AND
+!CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
+!EXEMPLARARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 
+!PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 
+!OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 
+!WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 
+!OTHERWISE), ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+!ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+Module binomial_coefficients 
+
+! Utilities to compute/return binomial coefficients. Utilities will
+! compute a table of n binomial coefficients, an array containing the
+! n+1 coefficients for a degree n polynomial, and single binomial
+! coefficients. Only double precision supported for now.
+
+USE ISO_FORTRAN_ENV, ONLY: DP=>REAL64
+ 
+  Integer,  PRIVATE :: mm 
+  Real(DP), PRIVATE, SAVE :: binomialCoefsTo20(0:20, 0:20) = TRANSPOSE(        &
+    RESHAPE(REAL([                                                             & 
+ !n=0                                                                    
+   1, (0, mm=1,20), &
+ !n=1
+   1, 1, (0, mm=1,19), &
+ !n=2
+   1, 2, 1, (0, mm=1,18), &
+ !n=3
+   1, 3, 3, 1, (0, mm=1,17), &
+! n=4
+   1, 4, 6, 4, 1, (0, mm=1,16), &
+! n=5
+   1, 5, 10, 10, 5, 1, (0, mm=1,15), &
+! n=6
+   1, 6, 15, 20, 15, 6, 1, (0, mm=1,14), &
+! n=7
+   1, 7, 21, 35, 35, 21, 7, 1, (0, mm=1,13), &
+! n=8
+   1, 8, 28, 56, 70, 56, 28, 8, 1, (0, mm=1,12), &
+! n=9
+   1, 9, 36, 84, 126, 126, 84, 36, 9, 1, (0, mm=1,11), &
+! n=10
+   1, 10, 45, 120, 210, 252, 210, 120, 45, 10, 1, (0, mm=1,10), &
+! n=11
+   1, 11, 55, 165, 330, 462, 462, 330, 165, 55, 11, 1, (0, mm=1,9), &
+! n=12
+   1, 12, 66, 220, 495, 792, 924, 792, 495, 220, 66, 12, 1, (0, mm=1,8), &
+! n=13
+   1, 13, 78, 286, 715, 1287, 1716, 1716, 1287, 715, 286, 78, 13, 1, (0, mm=1,7), &
+! n=14
+   1, 14, 91, 364, 1001, 2002, 3003, 3432, 3003, 2002, 1001, 364, 91, 14, 1, (0, mm=1,6), &
+! n=15
+   1, 15, 105, 455, 1365, 3003, 5005, 6435, 6435, 5005, 3003, 1365, 455, 105, 15, 1, (0, mm=1,5), &
+! n=16
+   1, 16, 120, 560, 1820, 4368, 8008, 11440, 12870, 11440, 8008, 4368, 1820, 560, 120, 16, 1, (0, mm=1,4), &
+! n=17
+   1, 17, 136, 680, 2380, 6188, 12376, 19448, 24310, 24310, 19448, 12376, 6188, 2380, 680, 136, 17, 1, (0, mm=1,3), &
+! n=18
+   1, 18, 153, 816, 3060, 8568, 18564, 31824, 43758, 48620, 43758, 31824, 18564, 8568, 3060, 816, 153, 18, 1, 0, 0, &
+! n=19
+   1, 19, 171, 969, 3876, 11628, 27132, 50388, 75582, 92378, 92378, 75582, 50388, 27132, 11628, 3876, 969, 171, 19, 1, 0, &
+! n=20
+   1, 20, 190, 1140, 4845, 15504, 38760, 77520, 125970, 167960, 184756, 167960, 125970, 77520, 38760, 15504, 4845, 1140, 190, 20, &
+    1],DP),[21,21]))
+
+
+  PRIVATE :: DP
+
+Contains
+
+! Define some support routines for generating binomial coefficients etc.
+
+ Pure Subroutine binomialCoefsArray(n, bincoefs)
+
+! Get array of all binomial coefficient for a given n .
+! bincoefs must be dimensioned (0:n), For n <= 20 the
+! binonialCoefsTo20 is used to create the array. For n>20
+! the first 0:20 rows are taken from binomialCoefsTo20 and
+! the remaining rows are generated by recursion.
+
+! This should return the coefs for any n in Table 24.1 in Abramowitz and Stegun
+! "Handbook of Mathematical Functions" for a given n. The recursion
+! relationship in given in Abramowitz and Stegun Eq. 3.1.4 (chapter 3, page 10 
+! in my version)
+
+  Implicit NONE
+
+  Integer,  Intent(IN)    :: n
+  Real(DP), Intent(INOUT) :: bincoefs(0:n)
+
+  Integer :: i, j
+
+  Real(DP) :: lastRow(0:n)
+
+! Initialize bincof array to zero and bincoef(0,0) to 1
+ 
+  bincoefs    = 0.0_DP 
+  bincoefs(0) = 1.0_DP
+
+! For n <= 20 get values from table
+
+  If (n <= 20) Then
+
+    bincoefs(0:n) = binomialCoefsTo20(n,0:n)
+
+  Else
+
+! Load lower triangle of binceofs array with row coefficients using the fact
+! that the value of a coefficient in the nth row is the sum of the two 
+! values above and to the left of it in the preceeding (n-1) row. 
+
+     lastRow = 0.0_DP
+     lastRow(0:20) = binomialCoefsTo20(20,:)
+
+     Do i=21,n
+       Do j=1,i
+         bincoefs(j) = lastRow(j) + lastRow(j-1)
+       EndDo
+       bincoefs(0) = 1.0_DP
+       bincoefs(i) = 1.0_DP
+       lastRow(0:i) = bincoefs(0:i)
+     EndDo
+   EndIf
+
+ End Subroutine binomialCoefsArray
+
+ Pure Subroutine getBinomialCoefsTable(n, bincoefs)
+
+! Generate binomial coefficient table for a given n . bincoefs
+! must be dimensioned (0:n, 0:n), For n <= 20 the
+! binonialCoefsTo20 is used to create the table. For n>20
+! the first 0:20 rows are taken from binomialCoefsTo20 and
+! the remaining rows are generated by recursion.
+
+! This should reproduce Table 24.1 in Abramowitz and Stegun
+! "Handbook of Mathematical Functions" for a given n. The recursion
+! relationship in given in Abramowitz and Stegun Eq. 3.1.4 (chapter 3, page 10 
+! in my version)
+
+  Implicit NONE
+
+  Integer,  Intent(IN)    :: n
+  Real(DP), Intent(INOUT) :: bincoefs(0: , 0:)
+
+  Integer :: i, j
+
+! Initialize bincof array to zero and bincoef(0,0) to 1
+ 
+  bincoefs      = 0.0_DP 
+  bincoefs(0,0) = 1.0_DP
+
+! For n <= 20 get values from table
+
+  If (n <= 20) Then
+    Do i=1,n
+      bincoefs(i,0:i) = binomialCoefsTo20(i,0:i)
+    EndDo
+  Else
+
+! Load lower triangle of binceofs array with row coefficients using the fact
+! that the value of a coefficient in the nth row is the sum of the two 
+! values above and to the left of it in the preceeding (n-1) row. 
+
+     bincoefs(0:20, 0:20) = binomialCoefsTo20(:,:)
+     Do i=20,n-1
+       Do j=1,i
+         bincoefs(i+1,j) = bincoefs(i,j) + bincoefs(i,j-1)
+       EndDo
+       bincoefs(i+1,0)   = 1.0_DP
+       bincoefs(i+1,i+1) = 1.0_DP
+     EndDo
+   EndIf
+
+ End Subroutine getBinomialCoefsTable
+
+ Pure Function binomialCoef(n, j) Result(bc)
+
+! Get the single binomial coefficient defined at (n,j)
+
+  Implicit NONE
+
+  Integer, Intent(IN) :: n, j
+  Real(DP)            :: bc 
+
+  Real(DP) :: bincoefs(0:n)
+
+  If (j>n .OR. j<0) Then
+    bc = 0.0_DP
+    RETURN
+  EndIf
+
+  If (j==n) Then
+    bc = 1.0_DP 
+  ElseIf (j>n) Then
+    bc = 0.0_DP
+  ElseIf (j==0) Then
+    bc = 1.0_DP 
+  ElseIf(n<=20) Then
+    bc = binomialCoefsTo20(n,j)
+  Else
+    Call binomialCoefsArray(n, bincoefs)
+    bc = bincoefs(j) 
+  EndIf
+
+ End Function binomialCoef
+
+End Module binomial_coefficients 

README.md

@@ -1,2 +1,23 @@
-# ModForUtils
-A collection of utilities written in Modern Fortran
+# Welcome to the Modern Fortran Utilities 
+
+## Description
+
+This repository contains several utility programs either written from scratch or refactored to Modern Fortran. Currently the various directories hold modules that support a variety of tasks including computing binomial coefficients, factorials, routines for checking for NaN and Infinity floating point exceptions, root finders, random number utils and array sorters. Future releases will expand on these utilities and add interpolation routines and other utilities.
+
+## Building the utilities
+
+There is a Makefile in each directory that is specific to each utility. The default compiler is the Intel ifort compiler but another Fortran compiler can be selected by typeing (for example)
+
+  cd root_finders
+  make FC=gfortran
+
+Currently each utility must be built manually and the required module and object files copied to the users directories.
+
+A global Makefile that will build all the utilities into libraries will be added in a future release. Only the root_finder utilities have a test program that is built along with the utilities. 
+
+
+## Contact
+
+   Dr. Richard Weed
+   Email: [email protected]
+

binomial_coefficients/Makefile

@@ -0,0 +1,15 @@
+SHELL=/bin/sh
+
+.SUFFIXES:
+.SUFFIXES: .o .F90 .f90
+
+FC=ifort
+FCFLAGS=-O2 -fPIC
+
+OBJS=binomial_coefficients.o
+
+binomial_coefficients.o: binomial_coefficients.f90 
+	$(FC) -c $(FCFLAGS) ./binomial_coefficients.f90
+
+clean:
+	rm -rf ./*.o ./*.mod ./*~ ./*.x