CC
CC  various special functions, taken from netlib's specfun package
CC
       double precision function erf_xx(arg,jint)
C------------------------------------------------------------------
C
C This packet evaluates  erf(x),  erfc(x),  and  exp(x*x)*erfc(x)
C   for a real argument  x.  It contains three FUNCTION type
C   subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
C   and one SUBROUTINE type subprogram, ERF_XX.  The calling
C   statements for the primary entries are:
C
C                   Y=ERF(X)     (or   Y=DERF(X)),
C
C                   Y=ERFC(X)    (or   Y=DERFC(X)),
C   and
C                   Y=ERFCX(X)   (or   Y=DERFCX(X)).
C
C   The routine  ERF_XX  is intended for internal packet use only,
C   all computations within the packet being concentrated in this
C   routine.  The function subprograms invoke  ERF_XX  with the
C   statement
C
C          CALL ERF_XX(ARG,RESULT,JINT)
C
C   where the parameter usage is as follows
C
C      Function                     Parameters for ERF_XX
C       call              ARG                  Result          JINT
C
C     ERF(ARG)      ANY REAL ARGUMENT         ERF(ARG)          0
C     ERFC(ARG)     ABS(ARG) .LT. XBIG        ERFC(ARG)         1
C     ERFCX(ARG)    XNEG .LT. ARG .LT. XMAX   ERFCX(ARG)        2
C
C   The main computation evaluates near-minimax approximations
C   from "Rational Chebyshev approximations for the error function"
C   by W. J. Cody, Math. Comp., 1969, PP. 631-638.  This
C   transportable program uses rational functions that theoretically
C   approximate  erf(x)  and  erfc(x)  to at least 18 significant
C   decimal digits.  The accuracy achieved depends on the arithmetic
C   system, the compiler, the intrinsic functions, and proper
C   selection of the machine-dependent constants.
C
C*******************************************************************
C*******************************************************************
C
C Explanation of machine-dependent constants
C
C   XMIN   = the smallest positive floating-point number.
C   XINF   = the largest positive finite floating-point number.
C   XNEG   = the largest negative argument acceptable to ERFCX;
C            the negative of the solution to the equation
C            2*exp(x*x) = XINF.
C   XSMALL = argument below which erf(x) may be represented by
C            2*x/sqrt(pi)  and above which  x*x  will not underflow.
C            A conservative value is the largest machine number X
C            such that   1.0 + X = 1.0   to machine precision.
C   XBIG   = largest argument acceptable to ERFC;  solution to
C            the equation:  W(x) * (1-0.5/x**2) = XMIN,  where
C            W(x) = exp(-x*x)/[x*sqrt(pi)].
C   XHUGE  = argument above which  1.0 - 1/(2*x*x) = 1.0  to
C            machine precision.  A conservative value is
C            1/[2*sqrt(XSMALL)]
C   XMAX   = largest acceptable argument to ERFCX; the minimum
C            of XINF and 1/[sqrt(pi)*XMIN].
C
C*******************************************************************
C*******************************************************************
C
C Error returns
C
C  The program returns  ERFC = 0      for  ARG .GE. XBIG;
C
C                       ERFCX = XINF  for  ARG .LT. XNEG;
C      and
C                       ERFCX = 0     for  ARG .GE. XMAX.
C
C Intrinsic functions required are:
C
C     ABS, INT, EXP
C
C
C  Author: W. J. Cody
C          Mathematics and Computer Science Division
C          Argonne National Laboratory
C          Argonne, IL 60439
C
C  Latest modification: March 19, 1990
C
c------------------------------------------------------------------
       integer i,jint
       double precision arg,del,four,half,one, y, ysq, sixteen
       double precision sqrpi,two,thresh,x,xbig,xden,xhuge
       double precision xinf,xmax,xneg,xnum,xsmall, zero
       double precision a(5),b(4),c(9),d(8),p(6),q(5)
c------------------------------------------------------------------
c  mathematical constants
c------------------------------------------------------------------
       parameter(four=4.d0,one=1.d0,half=0.5d0,two=2.d0,zero=0.d0)
       parameter(sqrpi=5.6418958354775628695d-1,thresh=0.46875d0)
       parameter(sixten=16.0d0)
c------------------------------------------------------------------
c  machine-dependent constants
c------------------------------------------------------------------
       parameter(xinf =1.d50, xneg=-22.d0, xsmall=1.d-16)
       parameter(xbig =22.d0,  xhuge=6.d6, xmax=xinf)
c------------------------------------------------------------------
c  coefficients for approximation to  erf  in first interval
c------------------------------------------------------------------
       data a/3.16112374387056560d00,1.13864154151050156d02,
     1      3.77485237685302021d02,3.20937758913846947d03,
     2      1.85777706184603153d-1/
       data b/2.36012909523441209d01,2.44024637934444173d02,
     1      1.28261652607737228d03,2.84423683343917062d03/
c------------------------------------------------------------------
c  coefficients for approximation to  erfc  in second interval
c------------------------------------------------------------------
       data c/5.64188496988670089d-1,8.88314979438837594d0,
     1      6.61191906371416295d01,2.98635138197400131d02,
     2      8.81952221241769090d02,1.71204761263407058d03,
     3      2.05107837782607147d03,1.23033935479799725d03,
     4      2.15311535474403846d-8/
       data d/1.57449261107098347d01,1.17693950891312499d02,
     1      5.37181101862009858d02,1.62138957456669019d03,
     2      3.29079923573345963d03,4.36261909014324716d03,
     3      3.43936767414372164d03,1.23033935480374942d03/
c------------------------------------------------------------------
c      coefficients for approximation to  erfc  in third interval
c------------------------------------------------------------------
       data p/3.05326634961232344d-1,3.60344899949804439d-1,
     1      1.25781726111229246d-1,1.60837851487422766d-2,
     2      6.58749161529837803d-4,1.63153871373020978d-2/
       data q/2.56852019228982242d00,1.87295284992346047d00,
     1      5.27905102951428412d-1,6.05183413124413191d-2,
     2      2.33520497626869185d-3/
c------------------------------------------------------------------
       x = arg
       y = abs(x)
       if (y .le. thresh) then
c------------------------------------------------------------------
c  evaluate  erf  for  |x| <= 0.46875
c------------------------------------------------------------------
          ysq = zero
          if (y .gt. xsmall) ysq = y * y
          xnum = a(5)*ysq
          xden = ysq
          do 20 i = 1, 3
             xnum = (xnum + a(i)) * ysq
             xden = (xden + b(i)) * ysq
 20       continue
          erf_xx = x * (xnum + a(4)) / (xden + b(4))
          if (jint .ne. 0) erf_xx = one - erf_xx
          if (jint .eq. 2) erf_xx = exp(ysq) * erf_xx
          go to 800
c------------------------------------------------------------------
c  evaluate  erfc  for 0.46875 <= |x| <= 4.0
c------------------------------------------------------------------
       else if (y .le. four) then
          xnum = c(9)*y
          xden = y
          do 120 i = 1, 7
             xnum = (xnum + c(i)) * y
             xden = (xden + d(i)) * y
 120      continue
          erf_xx = (xnum + c(8)) / (xden + d(8))
          if (jint .ne. 2) then
             ysq = int(y*sixten)/sixten
             del = (y-ysq)*(y+ysq)
             erf_xx = exp(-ysq*ysq) * exp(-del) * erf_xx
          end if
c------------------------------------------------------------------
c  evaluate  erfc  for |x| > 4.0
c------------------------------------------------------------------
       else
          erf_xx = zero
          if (y .ge. xbig) then
             if ((jint .ne. 2) .or. (y .ge. xmax)) go to 300
             if (y .ge. xhuge) then
                erf_xx = sqrpi / y
                go to 300
             end if
          end if
          ysq = one / (y * y)
          xnum = p(6)*ysq
          xden = ysq
          do 240 i = 1, 4
             xnum = (xnum + p(i)) * ysq
             xden = (xden + q(i)) * ysq
 240      continue
          erf_xx = ysq *(xnum + p(5)) / (xden + q(5))
          erf_xx = (sqrpi -  erf_xx) / y
          if (jint .ne. 2) then
             ysq   = int(y*sixten)/sixten
             del   = (y-ysq)*(y+ysq)
             erf_xx = exp(-ysq*ysq) * exp(-del) * erf_xx
          end if
       end if
c------------------------------------------------------------------
c  fix up for negative argument, erf, etc.
c------------------------------------------------------------------
 300   if (jint .eq. 0) then
          erf_xx = (half - erf_xx) + half
          if (x .lt. zero) erf_xx = -erf_xx
       else if (jint .eq. 1) then
          if (x .lt. zero) erf_xx = two - erf_xx
       else
          if (x .lt. zero) then
             if (x .lt. xneg) then
                erf_xx = xinf
             else
                ysq = int(x*sixten)/sixten
                del = (x-ysq)*(x+ysq)
                y   = exp(ysq*ysq) * exp(del)
                erf_xx = (y+y) - erf_xx
             end if
          end if
       end if
 800   return
       end
       DOUBLE PRECISION FUNCTION DGAMMA(X)
C----------------------------------------------------------------------
C
C This routine calculates the GAMMA function for a real argument X.
C   Computation is based on an algorithm outlined in reference 1.
C   The program uses rational functions that approximate the GAMMA
C   function to at least 20 significant decimal digits.  Coefficients
C   for the approximation over the interval (1,2) are unpublished.
C   Those for the approximation for X .GE. 12 are from reference 2.
C   The accuracy achieved depends on the arithmetic system, the
C   compiler, the intrinsic functions, and proper selection of the
C   machine-dependent constants.
C
C
C*******************************************************************
C*******************************************************************
C
C Explanation of machine-dependent constants
C
C beta   - radix for the floating-point representation
C maxexp - the smallest positive power of beta that overflows
C XBIG   - the largest argument for which GAMMA(X) is representable
C          in the machine, i.e., the solution to the equation
C                  GAMMA(XBIG) = beta**maxexp
C XINF   - the largest machine representable floating-point number;
C          approximately beta**maxexp
C EPS    - the smallest positive floating-point number such that
C          1.0+EPS .GT. 1.0
C XMININ - the smallest positive floating-point number such that
C          1/XMININ is machine representable
C
C     Approximate values for some important machines are:
C
C                            beta       maxexp        XBIG
C
C CRAY-1         (S.P.)        2         8191        966.961
C Cyber 180/855
C   under NOS    (S.P.)        2         1070        177.803
C IEEE (IBM/XT,
C   SUN, etc.)   (S.P.)        2          128        35.040
C IEEE (IBM/XT,
C   SUN, etc.)   (D.P.)        2         1024        171.624
C IBM 3033       (D.P.)       16           63        57.574
C VAX D-Format   (D.P.)        2          127        34.844
C VAX G-Format   (D.P.)        2         1023        171.489
C
C                            XINF         EPS        XMININ
C
C CRAY-1         (S.P.)   5.45E+2465   7.11E-15    1.84E-2466
C Cyber 180/855
C   under NOS    (S.P.)   1.26E+322    3.55E-15    3.14E-294
C IEEE (IBM/XT,
C   SUN, etc.)   (S.P.)   3.40E+38     1.19E-7     1.18E-38
C IEEE (IBM/XT,
C   SUN, etc.)   (D.P.)   1.79D+308    2.22D-16    2.23D-308
C IBM 3033       (D.P.)   7.23D+75     2.22D-16    1.39D-76
C VAX D-Format   (D.P.)   1.70D+38     1.39D-17    5.88D-39
C VAX G-Format   (D.P.)   8.98D+307    1.11D-16    1.12D-308
C
C*******************************************************************
C*******************************************************************
C
C Error returns
C
C  The program returns the value XINF for singularities or
C     when overflow would occur.  The computation is believed
C     to be free of underflow and overflow.
C
C
C  Intrinsic functions required are:
C
C     INT, DBLE, EXP, LOG, REAL, SIN
C
C
C References: "An Overview of Software Development for Special
C              Functions", W. J. Cody, Lecture Notes in Mathematics,
C              506, Numerical Analysis Dundee, 1975, G. A. Watson
C              (ed.), Springer Verlag, Berlin, 1976.
C
C              Computer Approximations, Hart, Et. Al., Wiley and
C              sons, New York, 1968.
C
C  Latest modification: October 12, 1989
C
C  Authors: W. J. Cody and L. Stoltz
C           Applied Mathematics Division
C           Argonne National Laboratory
C           Argonne, IL 60439
C
C----------------------------------------------------------------------
      INTEGER I,N
      LOGICAL PARITY
      DOUBLE PRECISION
     1    C,CONV,EPS,FACT,HALF,ONE,P,PI,Q,RES,SQRTPI,SUM,TWELVE,
     2    TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO
      DIMENSION C(7),P(8),Q(8)
C----------------------------------------------------------------------
C  Mathematical constants
C----------------------------------------------------------------------
      DATA ONE,HALF,TWELVE,TWO,ZERO/1.0D0,0.5D0,12.0D0,2.0D0,0.0D0/,
     1     SQRTPI/0.9189385332046727417803297D0/,
     2     PI/3.1415926535897932384626434D0/
C----------------------------------------------------------------------
C  Machine dependent parameters
C----------------------------------------------------------------------
      DATA XBIG,XMININ,EPS/171.624D0,2.23D-308,2.22D-16/,
     1     XINF/1.79D308/
C----------------------------------------------------------------------
C  Numerator and denominator coefficients for rational minimax
C     approximation over (1,2).
C----------------------------------------------------------------------
      DATA P/-1.71618513886549492533811D+0,2.47656508055759199108314D+1,
     1       -3.79804256470945635097577D+2,6.29331155312818442661052D+2,
     2       8.66966202790413211295064D+2,-3.14512729688483675254357D+4,
     3       -3.61444134186911729807069D+4,6.64561438202405440627855D+4/
      DATA Q/-3.08402300119738975254353D+1,3.15350626979604161529144D+2,
     1      -1.01515636749021914166146D+3,-3.10777167157231109440444D+3,
     2        2.25381184209801510330112D+4,4.75584627752788110767815D+3,
     3      -1.34659959864969306392456D+5,-1.15132259675553483497211D+5/
C----------------------------------------------------------------------
C  Coefficients for minimax approximation over (12, INF).
C----------------------------------------------------------------------
      DATA C/-1.910444077728D-03,8.4171387781295D-04,
     1     -5.952379913043012D-04,7.93650793500350248D-04,
     2     -2.777777777777681622553D-03,8.333333333333333331554247D-02,
     3      5.7083835261D-03/
C----------------------------------------------------------------------
C  Statement functions for conversion between integer and float
C----------------------------------------------------------------------
      CONV(I) = DBLE(I)
      PARITY = .FALSE.
      FACT = ONE
      N = 0
      Y = X
      IF (Y .LE. ZERO) THEN
C----------------------------------------------------------------------
C  Argument is negative
C----------------------------------------------------------------------
            Y = -X
            Y1 = AINT(Y)
            RES = Y - Y1
            IF (RES .NE. ZERO) THEN
                  IF (Y1 .NE. AINT(Y1*HALF)*TWO) PARITY = .TRUE.
                  FACT = -PI / SIN(PI*RES)
                  Y = Y + ONE
               ELSE
                  RES = XINF
                  GO TO 900
            END IF
      END IF
C----------------------------------------------------------------------
C  Argument is positive
C----------------------------------------------------------------------
      IF (Y .LT. EPS) THEN
C----------------------------------------------------------------------
C  Argument .LT. EPS
C----------------------------------------------------------------------
            IF (Y .GE. XMININ) THEN
                  RES = ONE / Y
               ELSE
                  RES = XINF
                  GO TO 900
            END IF
         ELSE IF (Y .LT. TWELVE) THEN
            Y1 = Y
            IF (Y .LT. ONE) THEN
C----------------------------------------------------------------------
C  0.0 .LT. argument .LT. 1.0
C----------------------------------------------------------------------
                  Z = Y
                  Y = Y + ONE
               ELSE
C----------------------------------------------------------------------
C  1.0 .LT. argument .LT. 12.0, reduce argument if necessary
C----------------------------------------------------------------------
                  N = INT(Y) - 1
                  Y = Y - CONV(N)
                  Z = Y - ONE
            END IF
C----------------------------------------------------------------------
C  Evaluate approximation for 1.0 .LT. argument .LT. 2.0
C----------------------------------------------------------------------
            XNUM = ZERO
            XDEN = ONE
            DO 260 I = 1, 8
               XNUM = (XNUM + P(I)) * Z
               XDEN = XDEN * Z + Q(I)
  260       CONTINUE
            RES = XNUM / XDEN + ONE
            IF (Y1 .LT. Y) THEN
C----------------------------------------------------------------------
C  Adjust result for case  0.0 .LT. argument .LT. 1.0
C----------------------------------------------------------------------
                  RES = RES / Y1
               ELSE IF (Y1 .GT. Y) THEN
C----------------------------------------------------------------------
C  Adjust result for case  2.0 .LT. argument .LT. 12.0
C----------------------------------------------------------------------
                  DO 290 I = 1, N
                     RES = RES * Y
                     Y = Y + ONE
  290             CONTINUE
            END IF
         ELSE
C----------------------------------------------------------------------
C  Evaluate for argument .GE. 12.0,
C----------------------------------------------------------------------
            IF (Y .LE. XBIG) THEN
                  YSQ = Y * Y
                  SUM = C(7)
                  DO 350 I = 1, 6
                     SUM = SUM / YSQ + C(I)
  350             CONTINUE
                  SUM = SUM/Y - Y + SQRTPI
                  SUM = SUM + (Y-HALF)*LOG(Y)
                  RES = EXP(SUM)
               ELSE
                  RES = XINF
                  GO TO 900
            END IF
      END IF
C----------------------------------------------------------------------
C  Final adjustments and return
C----------------------------------------------------------------------
      IF (PARITY) RES = -RES
      IF (FACT .NE. ONE) RES = FACT / RES
  900 DGAMMA = RES
      RETURN
C ---------- Last line of GAMMA ----------
      END
      DOUBLE PRECISION FUNCTION DLGAMA(X)
C----------------------------------------------------------------------
C
C This routine calculates the LOG(GAMMA) function for a positive real
C   argument X.  Computation is based on an algorithm outlined in
C   references 1 and 2.  The program uses rational functions that
C   theoretically approximate LOG(GAMMA) to at least 18 significant
C   decimal digits.  The approximation for X > 12 is from reference
C   3, while approximations for X < 12.0 are similar to those in
C   reference 1, but are unpublished.  The accuracy achieved depends
C   on the arithmetic system, the compiler, the intrinsic functions,
C   and proper selection of the machine-dependent constants.
C
C
C*********************************************************************
C*********************************************************************
C
C Explanation of machine-dependent constants
C
C beta   - radix for the floating-point representation
C maxexp - the smallest positive power of beta that overflows
C XBIG   - largest argument for which LN(GAMMA(X)) is representable
C          in the machine, i.e., the solution to the equation
C                  LN(GAMMA(XBIG)) = beta**maxexp
C XINF   - largest machine representable floating-point number;
C          approximately beta**maxexp.
C EPS    - The smallest positive floating-point number such that
C          1.0+EPS .GT. 1.0
C FRTBIG - Rough estimate of the fourth root of XBIG
C
C
C     Approximate values for some important machines are:
C
C                           beta      maxexp         XBIG
C
C CRAY-1        (S.P.)        2        8191       9.62E+2461
C Cyber 180/855
C   under NOS   (S.P.)        2        1070       1.72E+319
C IEEE (IBM/XT,
C   SUN, etc.)  (S.P.)        2         128       4.08E+36
C IEEE (IBM/XT,
C   SUN, etc.)  (D.P.)        2        1024       2.55D+305
C IBM 3033      (D.P.)       16          63       4.29D+73
C VAX D-Format  (D.P.)        2         127       2.05D+36
C VAX G-Format  (D.P.)        2        1023       1.28D+305
C
C
C                           XINF        EPS        FRTBIG
C
C CRAY-1        (S.P.)   5.45E+2465   7.11E-15    3.13E+615
C Cyber 180/855
C   under NOS   (S.P.)   1.26E+322    3.55E-15    6.44E+79
C IEEE (IBM/XT,
C   SUN, etc.)  (S.P.)   3.40E+38     1.19E-7     1.42E+9
C IEEE (IBM/XT,
C   SUN, etc.)  (D.P.)   1.79D+308    2.22D-16    2.25D+76
C IBM 3033      (D.P.)   7.23D+75     2.22D-16    2.56D+18
C VAX D-Format  (D.P.)   1.70D+38     1.39D-17    1.20D+9
C VAX G-Format  (D.P.)   8.98D+307    1.11D-16    1.89D+76
C
C**************************************************************
C**************************************************************
C
C Error returns
C
C  The program returns the value XINF for X .LE. 0.0 or when
C     overflow would occur.  The computation is believed to
C     be free of underflow and overflow.
C
C
C Intrinsic functions required are:
C
C      LOG
C
C
C References:
C
C  1) W. J. Cody and K. E. Hillstrom, 'Chebyshev Approximations for
C     the Natural Logarithm of the Gamma Function,' Math. Comp. 21,
C     1967, pp. 198-203.
C
C  2) K. E. Hillstrom, ANL/AMD Program ANLC366S, DGAMMA/DLGAMA, May,
C     1969.
C
C  3) Hart, Et. Al., Computer Approximations, Wiley and sons, New
C     York, 1968.
C
C
C  Authors: W. J. Cody and L. Stoltz
C           Argonne National Laboratory
C
C  Latest modification: June 16, 1988
C
C----------------------------------------------------------------------
      INTEGER I
      DOUBLE PRECISION
     1    C,CORR,D1,D2,D4,EPS,FRTBIG,FOUR,HALF,ONE,PNT68,P1,P2,P4,
     2    Q1,Q2,Q4,RES,SQRTPI,THRHAL,TWELVE,TWO,X,XBIG,XDEN,XINF,
     3    XM1,XM2,XM4,XNUM,Y,YSQ,ZERO
      DIMENSION C(7),P1(8),P2(8),P4(8),Q1(8),Q2(8),Q4(8)
C----------------------------------------------------------------------
C  Mathematical constants
C----------------------------------------------------------------------
      DATA ONE,HALF,TWELVE,ZERO/1.0D0,0.5D0,12.0D0,0.0D0/,
     1     FOUR,THRHAL,TWO,PNT68/4.0D0,1.5D0,2.0D0,0.6796875D0/,
     2     SQRTPI/0.9189385332046727417803297D0/
C----------------------------------------------------------------------
C  Machine dependent parameters
C----------------------------------------------------------------------
      DATA XBIG,XINF,EPS,FRTBIG/2.55D305,1.79D308,2.22D-16,2.25D76/
C----------------------------------------------------------------------
C  Numerator and denominator coefficients for rational minimax
C     approximation over (0.5,1.5).
C----------------------------------------------------------------------
      DATA D1/-5.772156649015328605195174D-1/
      DATA P1/4.945235359296727046734888D0,2.018112620856775083915565D2,
     1        2.290838373831346393026739D3,1.131967205903380828685045D4,
     2        2.855724635671635335736389D4,3.848496228443793359990269D4,
     3        2.637748787624195437963534D4,7.225813979700288197698961D3/
      DATA Q1/6.748212550303777196073036D1,1.113332393857199323513008D3,
     1        7.738757056935398733233834D3,2.763987074403340708898585D4,
     2        5.499310206226157329794414D4,6.161122180066002127833352D4,
     3        3.635127591501940507276287D4,8.785536302431013170870835D3/
C----------------------------------------------------------------------
C  Numerator and denominator coefficients for rational minimax
C     Approximation over (1.5,4.0).
C----------------------------------------------------------------------
      DATA D2/4.227843350984671393993777D-1/
      DATA P2/4.974607845568932035012064D0,5.424138599891070494101986D2,
     1        1.550693864978364947665077D4,1.847932904445632425417223D5,
     2        1.088204769468828767498470D6,3.338152967987029735917223D6,
     3        5.106661678927352456275255D6,3.074109054850539556250927D6/
      DATA Q2/1.830328399370592604055942D2,7.765049321445005871323047D3,
     1        1.331903827966074194402448D5,1.136705821321969608938755D6,
     2        5.267964117437946917577538D6,1.346701454311101692290052D7,
     3        1.782736530353274213975932D7,9.533095591844353613395747D6/
C----------------------------------------------------------------------
C  Numerator and denominator coefficients for rational minimax
C     Approximation over (4.0,12.0).
C----------------------------------------------------------------------
      DATA D4/1.791759469228055000094023D0/
      DATA P4/1.474502166059939948905062D4,2.426813369486704502836312D6,
     1        1.214755574045093227939592D8,2.663432449630976949898078D9,
     2      2.940378956634553899906876D10,1.702665737765398868392998D11,
     3      4.926125793377430887588120D11,5.606251856223951465078242D11/
      DATA Q4/2.690530175870899333379843D3,6.393885654300092398984238D5,
     2        4.135599930241388052042842D7,1.120872109616147941376570D9,
     3      1.488613728678813811542398D10,1.016803586272438228077304D11,
     4      3.417476345507377132798597D11,4.463158187419713286462081D11/
C----------------------------------------------------------------------
C  Coefficients for minimax approximation over (12, INF).
C----------------------------------------------------------------------
      DATA C/-1.910444077728D-03,8.4171387781295D-04,
     1     -5.952379913043012D-04,7.93650793500350248D-04,
     2     -2.777777777777681622553D-03,8.333333333333333331554247D-02,
     3      5.7083835261D-03/
C----------------------------------------------------------------------
      Y = X
      IF ((Y .GT. ZERO) .AND. (Y .LE. XBIG)) THEN
            IF (Y .LE. EPS) THEN
                  RES = -LOG(Y)
               ELSE IF (Y .LE. THRHAL) THEN
C----------------------------------------------------------------------
C  EPS .LT. X .LE. 1.5
C----------------------------------------------------------------------
                  IF (Y .LT. PNT68) THEN
                        CORR = -LOG(Y)
                        XM1 = Y
                     ELSE
                        CORR = ZERO
                        XM1 = (Y - HALF) - HALF
                  END IF
                  IF ((Y .LE. HALF) .OR. (Y .GE. PNT68)) THEN
                        XDEN = ONE
                        XNUM = ZERO
                        DO 140 I = 1, 8
                           XNUM = XNUM*XM1 + P1(I)
                           XDEN = XDEN*XM1 + Q1(I)
  140                   CONTINUE
                        RES = CORR + (XM1 * (D1 + XM1*(XNUM/XDEN)))
                     ELSE
                        XM2 = (Y - HALF) - HALF
                        XDEN = ONE
                        XNUM = ZERO
                        DO 220 I = 1, 8
                           XNUM = XNUM*XM2 + P2(I)
                           XDEN = XDEN*XM2 + Q2(I)
  220                   CONTINUE
                        RES = CORR + XM2 * (D2 + XM2*(XNUM/XDEN))
                  END IF
               ELSE IF (Y .LE. FOUR) THEN
C----------------------------------------------------------------------
C  1.5 .LT. X .LE. 4.0
C----------------------------------------------------------------------
                  XM2 = Y - TWO
                  XDEN = ONE
                  XNUM = ZERO
                  DO 240 I = 1, 8
                     XNUM = XNUM*XM2 + P2(I)
                     XDEN = XDEN*XM2 + Q2(I)
  240             CONTINUE
                  RES = XM2 * (D2 + XM2*(XNUM/XDEN))
               ELSE IF (Y .LE. TWELVE) THEN
C----------------------------------------------------------------------
C  4.0 .LT. X .LE. 12.0
C----------------------------------------------------------------------
                  XM4 = Y - FOUR
                  XDEN = -ONE
                  XNUM = ZERO
                  DO 340 I = 1, 8
                     XNUM = XNUM*XM4 + P4(I)
                     XDEN = XDEN*XM4 + Q4(I)
  340             CONTINUE
                  RES = D4 + XM4*(XNUM/XDEN)
               ELSE
C----------------------------------------------------------------------
C  Evaluate for argument .GE. 12.0,
C----------------------------------------------------------------------
                  RES = ZERO
                  IF (Y .LE. FRTBIG) THEN
                        RES = C(7)
                        YSQ = Y * Y
                        DO 450 I = 1, 6
                           RES = RES / YSQ + C(I)
  450                   CONTINUE
                  END IF
                  RES = RES/Y
                  CORR = LOG(Y)
                  RES = RES + SQRTPI - HALF*CORR
                  RES = RES + Y*(CORR-ONE)
            END IF
         ELSE
C----------------------------------------------------------------------
C  Return for bad arguments
C----------------------------------------------------------------------
            RES = XINF
      END IF
C----------------------------------------------------------------------
C  Final adjustments and return
C----------------------------------------------------------------------
      DLGAMA = RES
      RETURN
C ---------- Last line of DLGAMA ----------
      END


subroutine invers(matriz,NN)

 use f90_kind

 integer :: NN,INFO
 integer :: LWORK
 integer, DIMENSION(NN) :: IPIV

 complex(double), DIMENSION(NN,NN) :: matriz
 complex(double), DIMENSION(NN*4) :: WORK

  LWORK = 4*NN
  INFO = 0
  !CALL F07ARF(NN,NN,matriz,NN,IPIV,INFO)
  !if (INFO/=0) then
  ! write(*,*)'IFAIL=',INFO
  !end if
  !CALL F07AWF(NN,matriz,NN,IPIV,WORK,LWORK,INFO)
  CALL zgetrf(NN,NN,matriz,NN,IPIV,INFO)
  if (INFO/=0) then
   write(*,*)'IFAIL=',INFO
  end if
  CALL zgetri(NN,matriz,NN,IPIV,WORK,LWORK,INFO)

  if (INFO/=0) then
    write(*,*)'IFAIL=',INFO
    stop 'FUDEU!!! INVERSAO DA NAG FOI PRO CARALHO!'
  end if

  return

end subroutine invers


module interpolation
use phys_consts, only: wp

implicit none (type, external)
public

interface ! interp2d.f90
module pure function interp2_plaid(x1,x2,f,x1i,x2i)
real(wp), dimension(:), intent(in) :: x1, x2, x1i, x2i
real(wp), dimension(:,:), intent(in) :: f
real(wp) :: interp2_plaid(1:size(x1i,1),1:size(x2i,1))
end function interp2_plaid

module pure function interp2(x1,x2,f,x1i,x2i)
real(wp), dimension(:), intent(in) :: x1, x2, x1i, x2i
real(wp), dimension(:,:), intent(in) :: f
real(wp) :: interp2(1:size(x1i,1))
end function interp2
end interface

contains

pure real(wp) function interp1(x1,f,x1i)

!------------------------------------------------------------
!-------A 1D LINEAR INTERPOLATION FUNCTION.  THE INDEPENDENT
!-------VARIABLE FOR THE GIVEN DATA GRID MUST BE MONOTONICALLY
!-------INCREASING, BUT THE LOCATIONS FOR THE INTERPOLATION DATA
!-------CAN BE IN ANY ORDER.  NOTE THAT EXTRAPOLATION IS NOT DONE
!-------AT ALL BY THIS FUNCTION - VALUES OUTSIDE DOMAIN OF
!-------ORIGINAL DATA ARE SIMPLY SET TO ZERO.
!------------------------------------------------------------

real(wp), dimension(:), intent(in) :: x1,f, x1i
dimension :: interp1(1:size(x1i,1))

integer :: lx1,lx1i,ix1,ix1i
real(wp) :: slope

integer :: ix10,ix1fin

lx1=size(x1,1)
lx1i=size(x1i,1)

do ix1i=1,lx1i
!      !find the 'bin' for this point; i.e. find ix1 s.t. xi(ix1i) is between x(ix1-1) and x(ix1)
  ix10=1
  ix1=lx1/2
  ix1fin=lx1
  if (x1i(ix1i)>=x1(1) .and. x1i(ix1i)<=x1(lx1)) then    !in bounds
    do while(.not.(x1i(ix1i)>=x1(ix1-1) .and. x1i(ix1i)<=x1(ix1)))    !keep going until we are in the interval we want
      if (x1i(ix1i)>=x1(ix10) .and. x1i(ix1i)<=x1(ix1)) then    !left half (correct guess)
        ix1fin=ix1
      else    !wrong take the "right" half (har har)
        ix10=ix1
      end if
      ix1=(ix1fin+ix10)/2
      if (ix10==ix1) then
        ix1=lx1
      end if
    end do
  else if (x1i(ix1i)<x1(1)) then
    ix1=1
  else
    ix1=lx1
  end if

  !execute interpolation for this point
  if (ix1>1 .and. ix1<=lx1) then   !interpolation
    slope=(f(ix1)-f(ix1-1))/(x1(ix1)-x1(ix1-1))
    interp1(ix1i)=f(ix1-1)+slope*(x1i(ix1i)-x1(ix1-1))
  else
    interp1(ix1i)=0
  end if
end do

!THERE IS SOME ISSUE WITH POINTS OUTSIDE INTERPOLANT DOMAIN - THIS IS A
!WORKAROUND UNTIL I CAN PIN DOWN THE EXACT PROBLEM
do ix1i=1,lx1i
  if(x1i(ix1i)<x1(1) .or. x1i(ix1i)>x1(lx1)) then
    interp1(ix1i)=0
  end if
end do

end function interp1

pure real(wp) function interp3(x1,x2,x3,f,x1i,x2i,x3i)

!------------------------------------------------------------
!-------A 2D BILINEAR INTERPOLATION FUNCTION.  THIS VERSION ASSUMES
!-------THAT THE LIST OF OUTPUT POINTS IS A 'FLAT LIST' RATHER THAN
!-------DESCRIPTIVE OF A 2D MESHGRID.
!------------------------------------------------------------

real(wp), dimension(:), intent(in) :: x1,x2,x3,x1i,x2i,x3i
real(wp), dimension(:,:,:), intent(in) :: f
dimension :: interp3(1:size(x1i,1))     !interpolated points are a flat list

real(wp) :: fx1ix2pix3p,fx1ix2nix3p,fx1ix2pix3n,fx1ix2nix3n    !function estimates at x1i point  vs. at x2 interfaces
real(wp) :: fx2ix3p,fx2ix3n
real(wp) :: slope                     !temp value for slope for interpolations

integer :: lx1,lx2,lx3,lxi,ix1,ix2,ix3,ixi
integer :: ix10,ix1fin,ix20,ix2fin,ix30,ix3fin

lx1=size(x1,1)
lx2=size(x2,1)
lx3=size(x3,1)
lxi=size(x1i,1)    !only one size since this a flat list of grid points

do ixi=1,lxi
  !find the x1 'bin' for this point; i.e. find ix1 s.t. xi(ix1i) is between x(ix1-1) and x(ix1)
  ix10=1
  ix1=lx1/2
  ix1fin=lx1
  if (x1i(ixi)>=x1(1) .and. x1i(ixi)<=x1(lx1)) then    !in bounds
    do while(.not.(x1i(ixi)>=x1(ix1-1) .and. x1i(ixi)<=x1(ix1)))    !keep going until we are in the interval we want
      if (x1i(ixi)>=x1(ix10) .and. x1i(ixi)<=x1(ix1)) then    !left half (correct guess)
        ix1fin=ix1
      else    !wrong take the "right" half (har har)
        ix10=ix1
      end if
      ix1=(ix1fin+ix10)/2
      if (ix10==ix1) then
        ix1=lx1
      end if
    end do
  else if (x1i(ixi)<x1(1)) then
    ix1=1
  else
    ix1=lx1
  end if

  !find the x2 'bin' for this point; i.e. find ix2 s.t. x2i(ix2i) is between x2(ix2-1) and x2(ix2)
  ix20=1
  ix2=lx2/2
  ix2fin=lx2
  if (x2i(ixi)>=x2(1) .and. x2i(ixi)<=x2(lx2)) then    !in bounds
    do while(.not.(x2i(ixi)>=x2(ix2-1) .and. x2i(ixi)<=x2(ix2)))    !keep going until we are in the interval we want
      if (x2i(ixi)>=x2(ix20) .and. x2i(ixi)<=x2(ix2)) then    !left half (correct guess)
        ix2fin=ix2
      else    !wrong take the "right" half (har har)
        ix20=ix2
      end if
      ix2=(ix2fin+ix20)/2
      if (ix20==ix2) then
        ix2=lx2
      end if
    end do
  else if (x2i(ixi)<x2(1)) then
    ix2=1
  else
    ix2=lx2
  end if

  !find the x3 'bin' for this point; i.e. find ix3 s.t. x3i(ix3i) is between x3(ix3-1) and x3(ix3)
  ix30=1
  ix3=lx3/2
  ix3fin=lx3
  if (x3i(ixi)>=x3(1) .and. x3i(ixi)<=x3(lx3)) then    !in bounds
    do while(.not.(x3i(ixi)>=x3(ix3-1) .and. x3i(ixi)<=x3(ix3)))    !keep going until we are in the interval we want
      if (x3i(ixi)>=x3(ix30) .and. x3i(ixi)<=x3(ix3)) then    !left half (correct guess)
        ix3fin=ix3
      else    !wrong take the "right" half (har har)
        ix30=ix3
      end if
      ix3=(ix3fin+ix30)/2
      if (ix30==ix3) then
        ix3=lx3
      end if
    end do
  else if (x3i(ixi)<x3(1)) then
    ix3=1
  else
    ix3=lx3
  end if

  if (ix1>1 .and. ix1<=lx1 .and. ix2>1 .and. ix2<=lx2 .and. ix3>1 .and. ix3<=lx3) then   !interpolation
    !interpolate x1 for fixed values of x2,x3 (four separate interps)
    !first the "prev" x2 value, "prev" x2 value
    slope=(f(ix1,ix2-1,ix3-1)-f(ix1-1,ix2-1,ix3-1))/(x1(ix1)-x1(ix1-1))
    fx1ix2pix3p=f(ix1-1,ix2-1,ix3-1)+slope*(x1i(ixi)-x1(ix1-1))

    !now the "next" x2 value, "prev" x3
    slope=(f(ix1,ix2,ix3-1)-f(ix1-1,ix2,ix3-1))/(x1(ix1)-x1(ix1-1))
    fx1ix2nix3p=f(ix1-1,ix2,ix3-1)+slope*(x1i(ixi)-x1(ix1-1))

    !prev x2, next x3
    slope=(f(ix1,ix2-1,ix3)-f(ix1-1,ix2-1,ix3))/(x1(ix1)-x1(ix1-1))
    fx1ix2pix3n=f(ix1-1,ix2-1,ix3)+slope*(x1i(ixi)-x1(ix1-1))

    !next x3, next x3
    slope=(f(ix1,ix2,ix3)-f(ix1-1,ix2,ix3))/(x1(ix1)-x1(ix1-1))
    fx1ix2nix3n=f(ix1-1,ix2,ix3)+slope*(x1i(ixi)-x1(ix1-1))

    !interpolate between each x2 value (two separate interps)
    !interp in x2 for the x3 prev points
    slope=(fx1ix2nix3p-fx1ix2pix3p)/(x2(ix2)-x2(ix2-1))
    fx2ix3p=fx1ix2pix3p+slope*(x2i(ixi)-x2(ix2-1))

    !interp in 2 for the next x3 points
    slope=(fx1ix2nix3n-fx1ix2pix3n)/(x2(ix2)-x2(ix2-1))
    fx2ix3n=fx1ix2pix3n+slope*(x2i(ixi)-x2(ix2-1))

    !finally an interpolation in x2 to finish things off (single interp)
    slope=(fx2ix3n-fx2ix3p)/(x3(ix3)-x3(ix3-1))
    interp3(ixi)=fx2ix3p+slope*(x3i(ixi)-x3(ix3-1))
  else
    interp3(ixi)=0._wp
  end if
end do

!THERE IS SOME ISSUE WITH POINTS OUTSIDE INTERPOLANT DOMAIN - THIS IS A WORKAROUND UNTIL I CAN PIN DOWN THE EXACT PROBLEM
do ixi=1,lxi
if(x1i(ixi)<x1(1) .or. x1i(ixi)>x1(lx1) .or. x2i(ixi)<x2(1) .or. x2i(ixi)>x2(lx2) .or. x3i(ixi)<x3(1) .or. &
   x3i(ixi)>x3(lx3) .or. lx1==1 .or. lx2==1 .or. lx3==1) then     !also cover the case where there is a singleton dimension...
  interp3(ixi)=0._wp
end if
end do

end function interp3

end module interpolation


module setup_config_mod

use constants_mod

!! -------------------------------------------------------------------------- !!

real(dp), parameter :: init_time = 0.0
real(dp), parameter :: stop_time = 0.0

real(dp), parameter :: CFL = 0.9

real(dp), parameter :: beta = 0.8

real(dp), parameter :: dt_checkpoint = 1e-1

!! -------------------------------------------------------------------------- !!

real(dp), parameter :: dt_analyze = dt_checkpoint

real(dp), parameter :: chkpt_init_time = init_time
real(dp), parameter :: chkpt_stop_time = stop_time

!! -------------------------------------------------------------------------- !!

real(dp), parameter :: diameter = 1 * 0.2
!real(dp), parameter :: diameter = 2

real(dp), parameter :: xlim(2) = diameter * ((/0.0,1.0/) - 0.5)
real(dp), parameter :: ylim(2) = diameter * ((/0.0,1.0/) - 0.5)
real(dp), parameter :: zlim(2) = diameter * ((/0.0,1.0/) - 0.5)

!! -------------------------------------------------------------------------- !!

real(dp), parameter :: dens0 = 1.2558834406799149
real(dp), parameter :: pres0 = 54.608515091988004

real(dp), parameter :: velx0 = 0.0
real(dp), parameter :: vely0 = 0.0
real(dp), parameter :: velz0 = 0.0

real(dp), parameter :: kappa = 5.0_dp/3.0_dp

!! -------------------------------------------------------------------------- !!

integer, parameter :: mesh_minlevel = 3
integer, parameter :: mesh_maxlevel = 7

real(dp), parameter :: setup_amr_threshold_refine = -6
real(dp), parameter :: setup_amr_threshold_coarsen = -7

!! -------------------------------------------------------------------------- !!

real(dp), parameter :: grav = 0.004498512523396364
real(dp), parameter :: plummer = 1e-16_dp * diameter

end module


! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module test_triangle

  use, intrinsic :: iso_c_binding, only: c_bool, c_double, c_int, c_ptr, c_loc
  use triangle, only: &
       de_casteljau_one_round, evaluate_barycentric, &
       evaluate_barycentric_multi, evaluate_cartesian_multi, jacobian_both, &
       jacobian_det, specialize_triangle, subdivide_nodes, compute_edge_nodes, &
       shoelace_for_area, compute_area
  use types, only: dp
  use unit_test_helpers, only: &
       print_status, get_random_nodes, get_id_mat, ref_triangle_uniform_params
  implicit none
  private &
       test_de_casteljau_one_round, test_evaluate_barycentric, &
       test_evaluate_barycentric_multi, test_evaluate_cartesian_multi, &
       test_jacobian_both, test_jacobian_det, &
       test_specialize_triangle, test_subdivide_nodes, &
       subdivide_points_check, test_compute_edge_nodes, &
       test_shoelace_for_area, test_compute_area
  public triangle_all_tests

contains

  subroutine triangle_all_tests(success)
    logical(c_bool), intent(inout) :: success

    call test_de_casteljau_one_round(success)
    call test_evaluate_barycentric(success)
    call test_evaluate_barycentric_multi(success)
    call test_evaluate_cartesian_multi(success)
    call test_jacobian_both(success)
    call test_jacobian_det(success)
    call test_specialize_triangle(success)
    call test_subdivide_nodes(success)
    call test_compute_edge_nodes(success)
    call test_shoelace_for_area(success)
    call test_compute_area(success)

  end subroutine triangle_all_tests

  subroutine test_de_casteljau_one_round(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), nodes2(2, 6), nodes3(2, 10)
    real(c_double) :: new_nodes1(2, 1), new_nodes2(2, 3), new_nodes3(2, 6)
    real(c_double) :: expected1(2, 1), expected2(2, 3), expected3(2, 6)
    real(c_double) :: lambda1, lambda2, lambda3
    integer :: case_id
    character(22) :: name

    case_id = 1
    name = "de_casteljau_one_round"

    ! CASE 1: Linear reference triangle (just goes to point).
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    nodes1(:, 3) = [0.0_dp, 1.0_dp]
    lambda1 = 0.125_dp
    lambda2 = 0.5_dp
    lambda3 = 0.375_dp
    expected1(:, 1) = [lambda2, lambda3]
    call de_casteljau_one_round( &
         3, 2, nodes1, 1, &
         lambda1, lambda2, lambda3, new_nodes1)
    case_success = all(new_nodes1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    call get_random_nodes(nodes2, 790931, 1483, num_bits=8)
    ! NOTE: Use a fixed seed so the test is deterministic and round
    !       the nodes to 8 bits of precision to avoid round-off.
    lambda1 = 0.625_dp
    lambda2 = 0.25_dp
    lambda3 = 0.125_dp
    expected2(:, 1) = ( &
         lambda1 * nodes2(:, 1) + &  ! p200
         lambda2 * nodes2(:, 2) + &  ! p110
         lambda3 * nodes2(:, 4))  ! p101
    expected2(:, 2) = ( &
         lambda1 * nodes2(:, 2) + &  ! p110
         lambda2 * nodes2(:, 3) + &  ! p020
         lambda3 * nodes2(:, 5))  ! p011
    expected2(:, 3) = ( &
         lambda1 * nodes2(:, 4) + &  ! p101
         lambda2 * nodes2(:, 5) + &  ! p011
         lambda3 * nodes2(:, 6))  ! p002
    call de_casteljau_one_round( &
         6, 2, nodes2, 2, &
         lambda1, lambda2, lambda3, new_nodes2)
    case_success = all(new_nodes2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic triangle.
    nodes3(:, 1) = [0.0_dp, 0.0_dp]
    nodes3(:, 2) = [3.25_dp, 1.5_dp]
    nodes3(:, 3) = [6.5_dp, 1.5_dp]
    nodes3(:, 4) = [10.0_dp, 0.0_dp]
    nodes3(:, 5) = [1.5_dp, 3.25_dp]
    nodes3(:, 6) = [5.0_dp, 5.0_dp]
    nodes3(:, 7) = [10.0_dp, 5.25_dp]
    nodes3(:, 8) = [1.5_dp, 6.5_dp]
    nodes3(:, 9) = [5.25_dp, 10.0_dp]
    nodes3(:, 10) = [0.0_dp, 10.0_dp]
    lambda1 = 0.375_dp
    lambda2 = 0.25_dp
    lambda3 = 0.375_dp
    expected3(:, 1) = ( &
         lambda1 * nodes3(:, 1) + &  ! p300
         lambda2 * nodes3(:, 2) + &  ! p210
         lambda3 * nodes3(:, 5))  ! p201
    expected3(:, 2) = ( &
         lambda1 * nodes3(:, 2) + &  ! p210
         lambda2 * nodes3(:, 3) + &  ! p120
         lambda3 * nodes3(:, 6))  ! p111
    expected3(:, 3) = ( &
         lambda1 * nodes3(:, 3) + &  ! p120
         lambda2 * nodes3(:, 4) + &  ! p030
         lambda3 * nodes3(:, 7))  ! p021
    expected3(:, 4) = ( &
         lambda1 * nodes3(:, 5) + &  ! p201
         lambda2 * nodes3(:, 6) + &  ! p111
         lambda3 * nodes3(:, 8))  ! p102
    expected3(:, 5) = ( &
         lambda1 * nodes3(:, 6) + &  ! p111
         lambda2 * nodes3(:, 7) + &  ! p021
         lambda3 * nodes3(:, 9))  ! p012
    expected3(:, 6) = ( &
         lambda1 * nodes3(:, 8) + &  ! p102
         lambda2 * nodes3(:, 9) + &  ! p012
         lambda3 * nodes3(:, 10))  ! p003

    call de_casteljau_one_round( &
         10, 2, nodes3, 3, &
         lambda1, lambda2, lambda3, new_nodes3)
    case_success = all(new_nodes3 == expected3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_de_casteljau_one_round

  subroutine test_evaluate_barycentric(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), nodes2(2, 6), nodes3(3, 6)
    real(c_double) :: nodes4(2, 10), nodes5(2, 15)
    real(c_double) :: point1(2, 1), point2(3, 1)
    real(c_double) :: expected1(2, 1), expected2(3, 1)
    real(c_double) :: lambda1, lambda2, lambda3
    integer :: index_, i, j, k, trinomial
    integer :: case_id
    character(20) :: name

    case_id = 1
    name = "evaluate_barycentric"

    ! CASE 1: Linear triangle.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.5_dp]
    nodes1(:, 3) = [0.0_dp, 1.25_dp]
    lambda1 = 0.25_dp
    lambda2 = 0.5_dp
    lambda3 = 0.25_dp
    expected1(:, 1) = [0.5_dp, 0.5625_dp]
    call evaluate_barycentric( &
         3, 2, nodes1, 1, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    lambda1 = 0.0_dp
    lambda2 = 0.25_dp
    lambda3 = 0.75_dp
    nodes2(:, 1) = [0.0_dp, 0.0_dp]
    nodes2(:, 2) = [0.5_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.5_dp]
    nodes2(:, 4) = [0.5_dp, 1.25_dp]
    nodes2(:, 5) = [0.0_dp, 1.25_dp]
    nodes2(:, 6) = [0.0_dp, 0.5_dp]
    expected1(:, 1) = [0.0625_dp, 0.78125_dp]
    call evaluate_barycentric( &
         6, 2, nodes2, 2, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Quadratic triangle in 3D.
    nodes3(:, 1) = [0.0_dp, 0.0_dp, 1.0_dp]
    nodes3(:, 2) = [0.5_dp, 0.0_dp, 0.25_dp]
    nodes3(:, 3) = [1.0_dp, 0.5_dp, 0.0_dp]
    nodes3(:, 4) = [0.5_dp, 1.25_dp, 1.25_dp]
    nodes3(:, 5) = [0.0_dp, 1.25_dp, 0.5_dp]
    nodes3(:, 6) = [0.0_dp, 0.5_dp, -1.0_dp]
    lambda1 = 0.125_dp
    lambda2 = 0.375_dp
    lambda3 = 0.5_dp
    expected2(:, 1) = [0.25_dp, 0.8203125_dp, 0.1328125_dp]
    call evaluate_barycentric( &
         6, 3, nodes3, 2, lambda1, lambda2, lambda3, point2)
    case_success = all(point2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Cubic triangle.
    nodes4(:, 1) = [0.0_dp, 0.0_dp]
    nodes4(:, 2) = [0.25_dp, 0.0_dp]
    nodes4(:, 3) = [0.75_dp, 0.25_dp]
    nodes4(:, 4) = [1.0_dp, 0.0_dp]
    nodes4(:, 5) = [0.0_dp, 0.25_dp]
    nodes4(:, 6) = [0.375_dp, 0.25_dp]
    nodes4(:, 7) = [0.5_dp, 0.25_dp]
    nodes4(:, 8) = [0.0_dp, 0.5_dp]
    nodes4(:, 9) = [0.25_dp, 0.75_dp]
    nodes4(:, 10) = [0.0_dp, 1.0_dp]
    lambda1 = 0.125_dp
    lambda2 = 0.5_dp
    lambda3 = 0.375_dp
    expected1(:, 1) = [0.447265625_dp, 0.37060546875_dp]
    call evaluate_barycentric( &
         10, 2, nodes4, 3, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Quartic (random) triangle.
    call get_random_nodes(nodes5, 64441, 222, num_bits=8)
    ! NOTE: Use a fixed seed so the test is deterministic and round
    !       the nodes to 8 bits of precision to avoid round-off.
    lambda1 = 0.125_dp
    lambda2 = 0.375_dp
    lambda3 = 0.5_dp
    ! We will manually compute the expected output.
    expected1 = 0
    index_ = 1
    do k = 0, 4
       do j = 0, 4 - k
          i = 4 - j - k
          if (maxval([i, j, k]) == 4) then
             trinomial = 1
          else if (maxval([i, j, k]) == 3) then
             trinomial = 4
          else if (minval([i, j, k]) == 0) then
             trinomial = 6
          else
             trinomial = 12
          end if
          expected1(:, 1) = ( &
               expected1(:, 1) + &
               ( &
               trinomial * lambda1**i * lambda2**j * lambda3**k * &
               nodes5(:, index_)))
          ! Update the index.
          index_ = index_ + 1
       end do
    end do
    call evaluate_barycentric( &
         15, 2, nodes5, 4, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

  end subroutine test_evaluate_barycentric

  subroutine test_evaluate_barycentric_multi(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes(2, 3), param_vals(3, 3)
    real(c_double) :: evaluated(2, 3), expected(2, 3)
    real(c_double) :: nodes_deg0(2, 1)
    integer :: i
    integer :: case_id
    character(26) :: name

    case_id = 1
    name = "evaluate_barycentric_multi"

    ! CASE 1: Basic evaluation.
    nodes(:, 1) = [0.0_dp, 0.0_dp]
    nodes(:, 2) = [2.0_dp, 1.0_dp]
    nodes(:, 3) = [-3.0_dp, 2.0_dp]
    param_vals(1, :) = [1.0_dp, 0.0_dp, 0.0_dp]
    param_vals(2, :) = [0.0_dp, 1.0_dp, 0.0_dp]
    param_vals(3, :) = [0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 1) = [0.0_dp, 0.0_dp]
    expected(:, 2) = [2.0_dp, 1.0_dp]
    expected(:, 3) = [-0.5_dp, 1.5_dp]
    call evaluate_barycentric_multi( &
         3, 2, nodes, 1, 3, param_vals, evaluated)
    case_success = all(evaluated == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Values outside the domain.
    nodes(:, 1) = [0.0_dp, 0.0_dp]
    nodes(:, 2) = [3.0_dp, -1.0_dp]
    nodes(:, 3) = [1.0_dp, 0.0_dp]
    param_vals(1, :) = [0.25_dp, 0.25_dp, 0.25_dp]
    param_vals(2, :) = [-1.0_dp, -1.0_dp, 3.0_dp]
    param_vals(3, :) = [0.125_dp, 0.75_dp, 0.125_dp]
    expected(:, 1) = [1.0_dp, -0.25_dp]
    expected(:, 2) = [0.0_dp, 1.0_dp]
    expected(:, 3) = [2.375_dp, -0.75_dp]
    call evaluate_barycentric_multi( &
         3, 2, nodes, 1, 3, param_vals, evaluated)
    case_success = all(evaluated == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Degree zero "triangle"
    nodes_deg0(:, 1) = [1.5_dp, 7.75_dp]
    param_vals(1, :) = [0.5_dp, 0.25_dp, 0.25_dp]
    param_vals(2, :) = [0.25_dp, 0.125_dp, 0.625_dp]
    param_vals(3, :) = [0.75_dp, 0.25_dp, 0.0_dp]
    forall (i = 1:3)
       expected(:, i) = nodes_deg0(:, 1)
    end forall
    call evaluate_barycentric_multi( &
         1, 2, nodes_deg0, 0, 3, param_vals, evaluated)
    case_success = all(evaluated == expected)
    call print_status(name, case_id, case_success, success)

  end subroutine test_evaluate_barycentric_multi

  subroutine test_evaluate_cartesian_multi(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 6), param_vals1(4, 2)
    real(c_double) :: evaluated1(2, 4), expected1(2, 4)
    real(c_double) :: nodes2(2, 3), param_vals2(3, 2)
    real(c_double) :: evaluated2(2, 3), expected2(2, 3)
    real(c_double) :: nodes3(3, 1), param_vals3(16, 2)
    real(c_double) :: evaluated3(3, 16), expected3(3, 16)
    integer :: i
    integer :: case_id
    character(24) :: name

    case_id = 1
    name = "evaluate_cartesian_multi"

    ! CASE 1: Basic evaluation
    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [1.0_dp, 0.75_dp]
    nodes1(:, 3) = [2.0_dp, 1.0_dp]
    nodes1(:, 4) = [-1.5_dp, 1.0_dp]
    nodes1(:, 5) = [-0.5_dp, 1.5_dp]
    nodes1(:, 6) = [-3.0_dp, 2.0_dp]
    param_vals1(1, :) = [0.25_dp, 0.75_dp]
    param_vals1(2, :) = [0.0_dp, 0.0_dp]
    param_vals1(3, :) = [0.5_dp, 0.25_dp]
    param_vals1(4, :) = [0.25_dp, 0.375_dp]
    expected1(:, 1) = [-1.75_dp, 1.75_dp]
    expected1(:, 2) = [0.0_dp, 0.0_dp]
    expected1(:, 3) = [0.25_dp, 1.0625_dp]
    expected1(:, 4) = [-0.625_dp, 1.046875_dp]
    call evaluate_cartesian_multi( &
         6, 2, nodes1, 2, 4, param_vals1, evaluated1)
    case_success = all(evaluated1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Values outside the domain.
    nodes2(:, 1) = [0.0_dp, 2.0_dp]
    nodes2(:, 2) = [1.0_dp, 1.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    param_vals2(1, :) = [0.25_dp, 0.25_dp]
    param_vals2(2, :) = [-1.0_dp, 3.0_dp]
    param_vals2(3, :) = [0.75_dp, 0.125_dp]
    expected2(:, 1) = [0.5_dp, 1.25_dp]
    expected2(:, 2) = [2.0_dp, -3.0_dp]
    expected2(:, 3) = [0.875_dp, 1.0_dp]
    call evaluate_cartesian_multi( &
         3, 2, nodes2, 1, 3, param_vals2, evaluated2)
    case_success = all(evaluated2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Degree zero "triangle"
    nodes3(:, 1) = [-1.5_dp, 0.75_dp, 5.0_dp]
    forall (i = 1:16)
       expected3(:, i) = nodes3(:, 1)
    end forall
    call evaluate_cartesian_multi( &
         1, 3, nodes3, 0, 16, param_vals3, evaluated3)
    case_success = all(evaluated3 == expected3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_evaluate_cartesian_multi

  subroutine test_jacobian_both(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(1, 3), expected1(2, 1), new_nodes1(2, 1)
    real(c_double) :: nodes2(3, 6), expected2(6, 3), new_nodes2(6, 3)
    real(c_double) :: nodes3(2, 10), expected3(4, 6), new_nodes3(4, 6)
    integer :: case_id
    character(13) :: name

    case_id = 1
    name = "jacobian_both"

    ! CASE 1: Linear triangle.
    ! B(s, t) = -2s + 2t + 3
    nodes1(1, :) = [3.0_dp, 1.0_dp, 5.0_dp]
    ! B_s = -2
    ! B_t = 2
    expected1(:, 1) = [-2.0_dp, 2.0_dp]
    call jacobian_both( &
         3, 1, nodes1, 1, new_nodes1)
    case_success = all(new_nodes1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    ! B(s, t) = [
    !     4 s t - 2 s + 5 t^2 - 6 t + 3,
    !     -s (s - 2 t),
    !     8 s^2 - 10 s t - 2 s - 13 t^2 + 12 t + 1,
    ! ]
    !
    nodes2(:, 1) = [3.0_dp, 0.0_dp, 1.0_dp]
    nodes2(:, 2) = [2.0_dp, 0.0_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, -1.0_dp, 7.0_dp]
    nodes2(:, 4) = [0.0_dp, 0.0_dp, 7.0_dp]
    nodes2(:, 5) = [1.0_dp, 1.0_dp, 1.0_dp]
    nodes2(:, 6) = [2.0_dp, 0.0_dp, 0.0_dp]
    ! B_s = [
    !     4 t - 2,
    !     -2 s + 2 t,
    !     16 s - 10 t - 2,
    ! ]
    ! B_t = [
    !     4 s + 10 t - 6,
    !     2 s,
    !    -10 s - 26 t + 12,
    ! ]
    expected2(:, 1) = [-2.0_dp, 0.0_dp, -2.0_dp, -6.0_dp, 0.0_dp, 12.0_dp]
    expected2(:, 2) = [-2.0_dp, -2.0_dp, 14.0_dp, -2.0_dp, 2.0_dp, 2.0_dp]
    expected2(:, 3) = [2.0_dp, 2.0_dp, -12.0_dp, 4.0_dp, 0.0_dp, -14.0_dp]
    call jacobian_both( &
         6, 3, nodes2, 2, new_nodes2)
    case_success = all(new_nodes2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic triangle.
    ! B(s, t) = [
    !     -2s^3 + 9s^2t + 12st^2 - 12st + 3s - 2t^3 + 6t,
    !     (-10s^3 - 30s^2t + 30s^2 - 36st^2 + 42st -
    !          18s - 15t^3 + 30t^2 - 18t + 7),
    ! ]
    nodes3(:, 1) = [0.0_dp, 7.0_dp]
    nodes3(:, 2) = [1.0_dp, 1.0_dp]
    nodes3(:, 3) = [2.0_dp, 5.0_dp]
    nodes3(:, 4) = [1.0_dp, 9.0_dp]
    nodes3(:, 5) = [2.0_dp, 1.0_dp]
    nodes3(:, 6) = [1.0_dp, 2.0_dp]
    nodes3(:, 7) = [3.0_dp, 3.0_dp]
    nodes3(:, 8) = [4.0_dp, 5.0_dp]
    nodes3(:, 9) = [5.0_dp, 1.0_dp]
    nodes3(:, 10) = [4.0_dp, 4.0_dp]
    ! B_s = [
    !     -6s^2 + 18st + 12t^2 - 12t + 3,
    !     -30s^2 - 60st + 60s - 36t^2 + 42t - 18,
    ! ]
    ! B_t = [
    !     9s^2 + 24st - 12s - 6t^2 + 6,
    !     -30s^2 - 72st + 42s - 45t^2 + 60t - 18,
    ! ]
    expected3(:, 1) = [3.0_dp, -18.0_dp, 6.0_dp, -18.0_dp]
    expected3(:, 2) = [3.0_dp, 12.0_dp, 0.0_dp, 3.0_dp]
    expected3(:, 3) = [-3.0_dp, 12.0_dp, 3.0_dp, -6.0_dp]
    expected3(:, 4) = [-3.0_dp, 3.0_dp, 6.0_dp, 12.0_dp]
    expected3(:, 5) = [6.0_dp, 3.0_dp, 12.0_dp, -3.0_dp]
    expected3(:, 6) = [3.0_dp, -12.0_dp, 0.0_dp, -3.0_dp]
    call jacobian_both( &
         10, 2, nodes3, 3, new_nodes3)
    case_success = all(new_nodes3 == expected3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_jacobian_both

  subroutine test_jacobian_det(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), param_vals1(13, 2), evaluated1(13)
    real(c_double) :: nodes2(2, 6), param_vals2(4, 2)
    real(c_double) :: expected2(4), evaluated2(4)
    integer :: case_id
    character(12) :: name

    case_id = 1
    name = "jacobian_det"

    ! CASE 1: Linear triangle (determinant is area).
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    nodes1(:, 3) = [0.0_dp, 2.0_dp]
    call get_random_nodes(param_vals1, 308975611, 101301, num_bits=8)
    call jacobian_det( &
         3, nodes1, 1, 13, param_vals1, evaluated1)
    case_success = all(evaluated1 == 2.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic (i.e. non-linear) triangle.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [0.5_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    nodes2(:, 4) = [0.0_dp, 0.5_dp]
    nodes2(:, 5) = [1.0_dp, 1.0_dp]
    nodes2(:, 6) = [0.0_dp, 1.0_dp]
    ! B(s, t) = [s(t + 1), t(s + 1)]
    param_vals2(1, :) = [0.125_dp, 0.125_dp]
    param_vals2(2, :) = [0.5_dp, 0.375_dp]
    param_vals2(3, :) = [0.25_dp, 0.75_dp]
    param_vals2(4, :) = [1.0_dp, 0.0_dp]
    ! det(DB) = s + t + 1
    expected2 = param_vals2(:, 1) + param_vals2(:, 2) + 1.0_dp
    call jacobian_det( &
         6, nodes2, 2, 4, param_vals2, evaluated2)
    case_success = all(evaluated2 == expected2)
    call print_status(name, case_id, case_success, success)

  end subroutine test_jacobian_det

  subroutine test_specialize_triangle(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double), allocatable :: id_mat(:, :), specialized(:, :)
    real(c_double), allocatable :: expected(:, :)
    real(c_double) :: &
         weights0(3), weights1(3), weights2(3), weights3(3), &
         weights4(3), weights5(3)
    character(19) :: name

    case_id = 1
    name = "specialize_triangle"

    weights0 = [1.0_dp, 0.0_dp, 0.0_dp]
    weights1 = [0.5_dp, 0.5_dp, 0.0_dp]
    weights2 = [0.0_dp, 1.0_dp, 0.0_dp]
    weights3 = [0.5_dp, 0.0_dp, 0.5_dp]
    weights4 = [0.0_dp, 0.5_dp, 0.5_dp]
    weights5 = [0.0_dp, 0.0_dp, 1.0_dp]

    ! CASE 1: degree == 1, subdivision A
    allocate(id_mat(3, 3))
    id_mat = get_id_mat(3)
    allocate(specialized(3, 3))
    allocate(expected(3, 3))
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = [1.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 2) = [0.5_dp, 0.5_dp, 0.0_dp]
    expected(:, 3) = [0.5_dp, 0.0_dp, 0.5_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: degree == 1, subdivision B
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = [0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 2) = [0.5_dp, 0.0_dp, 0.5_dp]
    expected(:, 3) = [0.5_dp, 0.5_dp, 0.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: degree == 1, subdivision C
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = [0.5_dp, 0.5_dp, 0.0_dp]
    expected(:, 2) = [0.0_dp, 1.0_dp, 0.0_dp]
    expected(:, 3) = [0.0_dp, 0.5_dp, 0.5_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: degree == 1, subdivision D
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = [0.5_dp, 0.0_dp, 0.5_dp]
    expected(:, 2) = [0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 3) = [0.0_dp, 0.0_dp, 1.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! De-allocate and prepare for degree == 2
    deallocate(id_mat)
    deallocate(specialized)
    deallocate(expected)

    ! CASE 5: degree == 2, subdivision A
    id_mat = get_id_mat(6)
    allocate(specialized(6, 6))
    allocate(expected(6, 6))
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = [1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 2) = [0.5_dp, 0.5_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 3) = [0.25_dp, 0.5_dp, 0.25_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 4) = [0.5_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.0_dp]
    expected(:, 5) = [0.25_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 6) = [0.25_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.25_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: degree == 2, subdivision B
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = [0.0_dp, 0.0_dp, 0.25_dp, 0.0_dp, 0.5_dp, 0.25_dp]
    expected(:, 2) = [0.0_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp]
    expected(:, 3) = [0.25_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.25_dp]
    expected(:, 4) = [0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 5) = [0.25_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 6) = [0.25_dp, 0.5_dp, 0.25_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: degree == 2, subdivision C
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = [0.25_dp, 0.5_dp, 0.25_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 2) = [0.0_dp, 0.5_dp, 0.5_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 3) = [0.0_dp, 0.0_dp, 1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 4) = [0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 5) = [0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.5_dp, 0.0_dp]
    expected(:, 6) = [0.0_dp, 0.0_dp, 0.25_dp, 0.0_dp, 0.5_dp, 0.25_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: degree == 2, subdivision D
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = [0.25_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.25_dp]
    expected(:, 2) = [0.0_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp]
    expected(:, 3) = [0.0_dp, 0.0_dp, 0.25_dp, 0.0_dp, 0.5_dp, 0.25_dp]
    expected(:, 4) = [0.0_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.5_dp]
    expected(:, 5) = [0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 6) = [0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 1.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! De-allocate and prepare for degree == 3
    deallocate(id_mat)
    deallocate(specialized)
    deallocate(expected)

    ! CASE 9: degree == 3, subdivision A
    id_mat = get_id_mat(10)
    allocate(specialized(10, 10))
    allocate(expected(10, 10))
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = 0.125_dp * [8, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.125_dp * [4, 4, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.125_dp * [2, 4, 2, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.125_dp * [1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.125_dp * [4, 0, 0, 0, 4, 0, 0, 0, 0, 0]
    expected(:, 6) = 0.125_dp * [2, 2, 0, 0, 2, 2, 0, 0, 0, 0]
    expected(:, 7) = 0.125_dp * [1, 2, 1, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 8) = 0.125_dp * [2, 0, 0, 0, 4, 0, 0, 2, 0, 0]
    expected(:, 9) = 0.125_dp * [1, 1, 0, 0, 2, 2, 0, 1, 1, 0]
    expected(:, 10) = 0.125_dp * [1, 0, 0, 0, 3, 0, 0, 3, 0, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: degree == 3, subdivision B
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = 0.125_dp * [0, 0, 0, 1, 0, 0, 3, 0, 3, 1]
    expected(:, 2) = 0.125_dp * [0, 0, 1, 0, 0, 2, 1, 1, 2, 1]
    expected(:, 3) = 0.125_dp * [0, 1, 0, 0, 1, 2, 0, 2, 1, 1]
    expected(:, 4) = 0.125_dp * [1, 0, 0, 0, 3, 0, 0, 3, 0, 1]
    expected(:, 5) = 0.125_dp * [0, 0, 1, 1, 0, 2, 2, 1, 1, 0]
    expected(:, 6) = 0.125_dp * [0, 1, 1, 0, 1, 2, 1, 1, 1, 0]
    expected(:, 7) = 0.125_dp * [1, 1, 0, 0, 2, 2, 0, 1, 1, 0]
    expected(:, 8) = 0.125_dp * [0, 1, 2, 1, 1, 2, 1, 0, 0, 0]
    expected(:, 9) = 0.125_dp * [1, 2, 1, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 10) = 0.125_dp * [1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 11: degree == 3, subdivision C
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = 0.125_dp * [1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.125_dp * [0, 2, 4, 2, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.125_dp * [0, 0, 4, 4, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.125_dp * [0, 0, 0, 8, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.125_dp * [0, 1, 2, 1, 1, 2, 1, 0, 0, 0]
    expected(:, 6) = 0.125_dp * [0, 0, 2, 2, 0, 2, 2, 0, 0, 0]
    expected(:, 7) = 0.125_dp * [0, 0, 0, 4, 0, 0, 4, 0, 0, 0]
    expected(:, 8) = 0.125_dp * [0, 0, 1, 1, 0, 2, 2, 1, 1, 0]
    expected(:, 9) = 0.125_dp * [0, 0, 0, 2, 0, 0, 4, 0, 2, 0]
    expected(:, 10) = 0.125_dp * [0, 0, 0, 1, 0, 0, 3, 0, 3, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 12: degree == 3, subdivision D
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = 0.125_dp * [1, 0, 0, 0, 3, 0, 0, 3, 0, 1]
    expected(:, 2) = 0.125_dp * [0, 1, 0, 0, 1, 2, 0, 2, 1, 1]
    expected(:, 3) = 0.125_dp * [0, 0, 1, 0, 0, 2, 1, 1, 2, 1]
    expected(:, 4) = 0.125_dp * [0, 0, 0, 1, 0, 0, 3, 0, 3, 1]
    expected(:, 5) = 0.125_dp * [0, 0, 0, 0, 2, 0, 0, 4, 0, 2]
    expected(:, 6) = 0.125_dp * [0, 0, 0, 0, 0, 2, 0, 2, 2, 2]
    expected(:, 7) = 0.125_dp * [0, 0, 0, 0, 0, 0, 2, 0, 4, 2]
    expected(:, 8) = 0.125_dp * [0, 0, 0, 0, 0, 0, 0, 4, 0, 4]
    expected(:, 9) = 0.125_dp * [0, 0, 0, 0, 0, 0, 0, 0, 4, 4]
    expected(:, 10) = 0.125_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 8]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! De-allocate and prepare for degree == 4
    deallocate(id_mat)
    deallocate(specialized)
    deallocate(expected)

    ! CASE 13: degree == 4, subdivision A
    id_mat = get_id_mat(15)
    allocate(specialized(15, 15))
    allocate(expected(15, 15))
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = 0.0625_dp * [16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.0625_dp * [8, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.0625_dp * [4, 8, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.0625_dp * [2, 6, 6, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.0625_dp * [1, 4, 6, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 6) = 0.0625_dp * [8, 0, 0, 0, 0, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 7) = 0.0625_dp * [4, 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 8) = 0.0625_dp * [2, 4, 2, 0, 0, 2, 4, 2, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 9) = 0.0625_dp * [1, 3, 3, 1, 0, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 10) = 0.0625_dp * [4, 0, 0, 0, 0, 8, 0, 0, 0, 4, 0, 0, 0, 0, 0]
    expected(:, 11) = 0.0625_dp * [2, 2, 0, 0, 0, 4, 4, 0, 0, 2, 2, 0, 0, 0, 0]
    expected(:, 12) = 0.0625_dp * [1, 2, 1, 0, 0, 2, 4, 2, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 13) = 0.0625_dp * [2, 0, 0, 0, 0, 6, 0, 0, 0, 6, 0, 0, 2, 0, 0]
    expected(:, 14) = 0.0625_dp * [1, 1, 0, 0, 0, 3, 3, 0, 0, 3, 3, 0, 1, 1, 0]
    expected(:, 15) = 0.0625_dp * [1, 0, 0, 0, 0, 4, 0, 0, 0, 6, 0, 0, 4, 0, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 14: degree == 4, subdivision B
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = 0.0625_dp * [0, 0, 0, 0, 1, 0, 0, 0, 4, 0, 0, 6, 0, 4, 1]
    expected(:, 2) = 0.0625_dp * [0, 0, 0, 1, 0, 0, 0, 3, 1, 0, 3, 3, 1, 3, 1]
    expected(:, 3) = 0.0625_dp * [0, 0, 1, 0, 0, 0, 2, 2, 0, 1, 4, 1, 2, 2, 1]
    expected(:, 4) = 0.0625_dp * [0, 1, 0, 0, 0, 1, 3, 0, 0, 3, 3, 0, 3, 1, 1]
    expected(:, 5) = 0.0625_dp * [1, 0, 0, 0, 0, 4, 0, 0, 0, 6, 0, 0, 4, 0, 1]
    expected(:, 6) = 0.0625_dp * [0, 0, 0, 1, 1, 0, 0, 3, 3, 0, 3, 3, 1, 1, 0]
    expected(:, 7) = 0.0625_dp * [0, 0, 1, 1, 0, 0, 2, 3, 1, 1, 3, 2, 1, 1, 0]
    expected(:, 8) = 0.0625_dp * [0, 1, 1, 0, 0, 1, 3, 2, 0, 2, 3, 1, 1, 1, 0]
    expected(:, 9) = 0.0625_dp * [1, 1, 0, 0, 0, 3, 3, 0, 0, 3, 3, 0, 1, 1, 0]
    expected(:, 10) = 0.0625_dp * [0, 0, 1, 2, 1, 0, 2, 4, 2, 1, 2, 1, 0, 0, 0]
    expected(:, 11) = 0.0625_dp * [0, 1, 2, 1, 0, 1, 3, 3, 1, 1, 2, 1, 0, 0, 0]
    expected(:, 12) = 0.0625_dp * [1, 2, 1, 0, 0, 2, 4, 2, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 13) = 0.0625_dp * [0, 1, 3, 3, 1, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 14) = 0.0625_dp * [1, 3, 3, 1, 0, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 15) = 0.0625_dp * [1, 4, 6, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 15: degree == 4, subdivision C
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = 0.0625_dp * [1, 4, 6, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.0625_dp * [0, 2, 6, 6, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.0625_dp * [0, 0, 4, 8, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.0625_dp * [0, 0, 0, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.0625_dp * [0, 0, 0, 0, 16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 6) = 0.0625_dp * [0, 1, 3, 3, 1, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 7) = 0.0625_dp * [0, 0, 2, 4, 2, 0, 2, 4, 2, 0, 0, 0, 0, 0, 0]
    expected(:, 8) = 0.0625_dp * [0, 0, 0, 4, 4, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0]
    expected(:, 9) = 0.0625_dp * [0, 0, 0, 0, 8, 0, 0, 0, 8, 0, 0, 0, 0, 0, 0]
    expected(:, 10) = 0.0625_dp * [0, 0, 1, 2, 1, 0, 2, 4, 2, 1, 2, 1, 0, 0, 0]
    expected(:, 11) = 0.0625_dp * [0, 0, 0, 2, 2, 0, 0, 4, 4, 0, 2, 2, 0, 0, 0]
    expected(:, 12) = 0.0625_dp * [0, 0, 0, 0, 4, 0, 0, 0, 8, 0, 0, 4, 0, 0, 0]
    expected(:, 13) = 0.0625_dp * [0, 0, 0, 1, 1, 0, 0, 3, 3, 0, 3, 3, 1, 1, 0]
    expected(:, 14) = 0.0625_dp * [0, 0, 0, 0, 2, 0, 0, 0, 6, 0, 0, 6, 0, 2, 0]
    expected(:, 15) = 0.0625_dp * [0, 0, 0, 0, 1, 0, 0, 0, 4, 0, 0, 6, 0, 4, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 16: degree == 4, subdivision D
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = 0.0625_dp * [1, 0, 0, 0, 0, 4, 0, 0, 0, 6, 0, 0, 4, 0, 1]
    expected(:, 2) = 0.0625_dp * [0, 1, 0, 0, 0, 1, 3, 0, 0, 3, 3, 0, 3, 1, 1]
    expected(:, 3) = 0.0625_dp * [0, 0, 1, 0, 0, 0, 2, 2, 0, 1, 4, 1, 2, 2, 1]
    expected(:, 4) = 0.0625_dp * [0, 0, 0, 1, 0, 0, 0, 3, 1, 0, 3, 3, 1, 3, 1]
    expected(:, 5) = 0.0625_dp * [0, 0, 0, 0, 1, 0, 0, 0, 4, 0, 0, 6, 0, 4, 1]
    expected(:, 6) = 0.0625_dp * [0, 0, 0, 0, 0, 2, 0, 0, 0, 6, 0, 0, 6, 0, 2]
    expected(:, 7) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 2, 0, 0, 2, 4, 0, 4, 2, 2]
    expected(:, 8) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 4, 2, 2, 4, 2]
    expected(:, 9) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 6, 0, 6, 2]
    expected(:, 10) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 8, 0, 4]
    expected(:, 11) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 4, 4, 4]
    expected(:, 12) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 8, 4]
    expected(:, 13) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 8]
    expected(:, 14) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 8]
    expected(:, 15) = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

  end subroutine test_specialize_triangle

  subroutine test_subdivide_nodes(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes_a1(2, 3), nodes_b1(2, 3)
    real(c_double) :: nodes_c1(2, 3), nodes_d1(2, 3)
    real(c_double) :: expected_a1(2, 3), expected_b1(2, 3)
    real(c_double) :: expected_c1(2, 3), expected_d1(2, 3)
    real(c_double) :: nodes2(2, 6)
    real(c_double) :: nodes_a2(2, 6), nodes_b2(2, 6)
    real(c_double) :: nodes_c2(2, 6), nodes_d2(2, 6)
    real(c_double) :: expected_a2(2, 6), expected_b2(2, 6)
    real(c_double) :: expected_c2(2, 6), expected_d2(2, 6)
    real(c_double) :: nodes3(2, 10)
    real(c_double) :: nodes_a3(2, 10), nodes_b3(2, 10)
    real(c_double) :: nodes_c3(2, 10), nodes_d3(2, 10)
    real(c_double) :: expected_a3(2, 10), expected_b3(2, 10)
    real(c_double) :: expected_c3(2, 10), expected_d3(2, 10)
    integer :: case_id
    character(26) :: name

    case_id = 1
    name = "subdivide_nodes (Triangle)"

    ! CASE 1: Linear triangle.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    nodes1(:, 3) = [0.0_dp, 1.0_dp]
    expected_a1(:, 1) = 0
    expected_a1(:, 2) = [0.5_dp, 0.0_dp]
    expected_a1(:, 3) = [0.0_dp, 0.5_dp]
    expected_b1(:, 1) = 0.5_dp
    expected_b1(:, 2) = [0.0_dp, 0.5_dp]
    expected_b1(:, 3) = [0.5_dp, 0.0_dp]
    expected_c1(:, 1) = [0.5_dp, 0.0_dp]
    expected_c1(:, 2) = [1.0_dp, 0.0_dp]
    expected_c1(:, 3) = 0.5_dp
    expected_d1(:, 1) = [0.0_dp, 0.5_dp]
    expected_d1(:, 2) = 0.5_dp
    expected_d1(:, 3) = [0.0_dp, 1.0_dp]
    call subdivide_nodes( &
         3, 2, nodes1, 1, &
         nodes_a1, nodes_b1, nodes_c1, nodes_d1)
    case_success = ( &
         all(nodes_a1 == expected_a1) .AND. &
         all(nodes_b1 == expected_b1) .AND. &
         all(nodes_c1 == expected_c1) .AND. &
         all(nodes_d1 == expected_d1))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Evaluate subdivided parts of a linear triangle.
    call subdivide_points_check( &
         3, 2, 1, 290289, 111228, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Quadratic triangle.
    nodes2(:, 1) = [0.0_dp, 0.0_dp]
    nodes2(:, 2) = [0.5_dp, 0.25_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    nodes2(:, 4) = [0.5_dp, 0.75_dp]
    nodes2(:, 5) = [0.0_dp, 1.0_dp]
    nodes2(:, 6) = [0.0_dp, 0.5_dp]
    expected_a2(:, 1) = [0.0_dp, 0.0_dp]
    expected_a2(:, 2) = [0.25_dp, 0.125_dp]
    expected_a2(:, 3) = [0.5_dp, 0.125_dp]
    expected_a2(:, 4) = [0.25_dp, 0.375_dp]
    expected_a2(:, 5) = [0.25_dp, 0.5_dp]
    expected_a2(:, 6) = [0.25_dp, 0.5_dp]
    expected_b2(:, 1) = [0.25_dp, 0.625_dp]
    expected_b2(:, 2) = [0.25_dp, 0.625_dp]
    expected_b2(:, 3) = [0.25_dp, 0.5_dp]
    expected_b2(:, 4) = [0.5_dp, 0.5_dp]
    expected_b2(:, 5) = [0.25_dp, 0.5_dp]
    expected_b2(:, 6) = [0.5_dp, 0.125_dp]
    expected_c2(:, 1) = [0.5_dp, 0.125_dp]
    expected_c2(:, 2) = [0.75_dp, 0.125_dp]
    expected_c2(:, 3) = [1.0_dp, 0.0_dp]
    expected_c2(:, 4) = [0.5_dp, 0.5_dp]
    expected_c2(:, 5) = [0.5_dp, 0.5_dp]
    expected_c2(:, 6) = [0.25_dp, 0.625_dp]
    expected_d2(:, 1) = [0.25_dp, 0.5_dp]
    expected_d2(:, 2) = [0.25_dp, 0.625_dp]
    expected_d2(:, 3) = [0.25_dp, 0.625_dp]
    expected_d2(:, 4) = [0.25_dp, 0.625_dp]
    expected_d2(:, 5) = [0.0_dp, 0.75_dp]
    expected_d2(:, 6) = [0.0_dp, 0.5_dp]
    call subdivide_nodes( &
         6, 2, nodes2, 2, &
         nodes_a2, nodes_b2, nodes_c2, nodes_d2)
    case_success = ( &
         all(nodes_a2 == expected_a2) .AND. &
         all(nodes_b2 == expected_b2) .AND. &
         all(nodes_c2 == expected_c2) .AND. &
         all(nodes_d2 == expected_d2))
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Evaluate subdivided parts of a quadratic triangle.
    call subdivide_points_check( &
         6, 2, 2, 219803, 7086, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Cubic triangle.
    nodes3(:, 1) = [0.0_dp, 0.0_dp]
    nodes3(:, 2) = [3.25_dp, 1.5_dp]
    nodes3(:, 3) = [6.5_dp, 1.5_dp]
    nodes3(:, 4) = [10.0_dp, 0.0_dp]
    nodes3(:, 5) = [1.5_dp, 3.25_dp]
    nodes3(:, 6) = [5.0_dp, 5.0_dp]
    nodes3(:, 7) = [10.0_dp, 5.25_dp]
    nodes3(:, 8) = [1.5_dp, 6.5_dp]
    nodes3(:, 9) = [5.25_dp, 10.0_dp]
    nodes3(:, 10) = [0.0_dp, 10.0_dp]
    expected_a3(:, 1) = [0.0_dp, 0.0_dp]
    expected_a3(:, 2) = [1.625_dp, 0.75_dp]
    expected_a3(:, 3) = [3.25_dp, 1.125_dp]
    expected_a3(:, 4) = [4.90625_dp, 1.125_dp]
    expected_a3(:, 5) = [0.75_dp, 1.625_dp]
    expected_a3(:, 6) = [2.4375_dp, 2.4375_dp]
    expected_a3(:, 7) = [4.3125_dp, 2.875_dp]
    expected_a3(:, 8) = [1.125_dp, 3.25_dp]
    expected_a3(:, 9) = [2.875_dp, 4.3125_dp]
    expected_a3(:, 10) = [1.125_dp, 4.90625_dp]
    expected_b3(:, 1) = [6.96875_dp, 6.96875_dp]
    expected_b3(:, 2) = [4.8125_dp, 6.65625_dp]
    expected_b3(:, 3) = [2.875_dp, 5.96875_dp]
    expected_b3(:, 4) = [1.125_dp, 4.90625_dp]
    expected_b3(:, 5) = [6.65625_dp, 4.8125_dp]
    expected_b3(:, 6) = [4.75_dp, 4.75_dp]
    expected_b3(:, 7) = [2.875_dp, 4.3125_dp]
    expected_b3(:, 8) = [5.96875_dp, 2.875_dp]
    expected_b3(:, 9) = [4.3125_dp, 2.875_dp]
    expected_b3(:, 10) = [4.90625_dp, 1.125_dp]
    expected_c3(:, 1) = [4.90625_dp, 1.125_dp]
    expected_c3(:, 2) = [6.5625_dp, 1.125_dp]
    expected_c3(:, 3) = [8.25_dp, 0.75_dp]
    expected_c3(:, 4) = [10.0_dp, 0.0_dp]
    expected_c3(:, 5) = [5.96875_dp, 2.875_dp]
    expected_c3(:, 6) = [7.875_dp, 2.9375_dp]
    expected_c3(:, 7) = [10.0_dp, 2.625_dp]
    expected_c3(:, 8) = [6.65625_dp, 4.8125_dp]
    expected_c3(:, 9) = [8.8125_dp, 5.125_dp]
    expected_c3(:, 10) = [6.96875_dp, 6.96875_dp]
    expected_d3(:, 1) = [1.125_dp, 4.90625_dp]
    expected_d3(:, 2) = [2.875_dp, 5.96875_dp]
    expected_d3(:, 3) = [4.8125_dp, 6.65625_dp]
    expected_d3(:, 4) = [6.96875_dp, 6.96875_dp]
    expected_d3(:, 5) = [1.125_dp, 6.5625_dp]
    expected_d3(:, 6) = [2.9375_dp, 7.875_dp]
    expected_d3(:, 7) = [5.125_dp, 8.8125_dp]
    expected_d3(:, 8) = [0.75_dp, 8.25_dp]
    expected_d3(:, 9) = [2.625_dp, 10.0_dp]
    expected_d3(:, 10) = [0.0_dp, 10.0_dp]
    call subdivide_nodes( &
         10, 2, nodes3, 3, &
         nodes_a3, nodes_b3, nodes_c3, nodes_d3)
    case_success = ( &
         all(nodes_a3 == expected_a3) .AND. &
         all(nodes_b3 == expected_b3) .AND. &
         all(nodes_c3 == expected_c3) .AND. &
         all(nodes_d3 == expected_d3))
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Evaluate subdivided parts of a cubic triangle.
    call subdivide_points_check( &
         10, 2, 3, 439028340, 2184938, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Evaluate subdivided parts of a quartic triangle.
    call subdivide_points_check( &
         15, 2, 4, 1029038, 890012, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Evaluate subdivided parts of a quantic triangle. This
    !         will use ``specialize_triangle`` rather than a hard-coded
    !         process.
    call subdivide_points_check( &
         21, 2, 5, 91889, 1303497, case_success)
    call print_status(name, case_id, case_success, success)

  end subroutine test_subdivide_nodes

  subroutine subdivide_points_check( &
       num_nodes, dimension_, degree, multiplier, modulus, success)
    integer, intent(in) :: num_nodes, dimension_, degree
    integer, intent(in) :: multiplier, modulus
    logical, intent(out) :: success
    ! Variables outside of signature.
    real(c_double) :: nodes(dimension_, num_nodes)
    real(c_double) :: nodes_a(dimension_, num_nodes)
    real(c_double) :: nodes_b(dimension_, num_nodes)
    real(c_double) :: nodes_c(dimension_, num_nodes)
    real(c_double) :: nodes_d(dimension_, num_nodes)
    real(c_double) :: ref_triangle(561, 2), local_vals(561, 2)
    real(c_double) :: evaluated1(dimension_, 561)
    real(c_double) :: evaluated2(dimension_, 561)

    success = .TRUE.

    call get_random_nodes(nodes, multiplier, modulus, num_bits=8)
    call subdivide_nodes( &
         num_nodes, dimension_, nodes, degree, &
         nodes_a, nodes_b, nodes_c, nodes_d)

    ref_triangle = ref_triangle_uniform_params(5)

    ! Evaluate the **original** at ``local_vals`` and the subdivided version
    ! on the full unit triangle.
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_a, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp * ref_triangle
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_b, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp - 0.5_dp * ref_triangle
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_c, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp * ref_triangle
    local_vals(:, 1) = local_vals(:, 1) + 0.5_dp
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_d, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp * ref_triangle
    local_vals(:, 2) = local_vals(:, 2) + 0.5_dp
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

  end subroutine subdivide_points_check

  subroutine test_compute_edge_nodes(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(18) :: name
    real(c_double), allocatable :: nodes(:, :)
    real(c_double), allocatable :: nodes1(:, :), nodes2(:, :), nodes3(:, :)

    case_id = 1
    name = "compute_edge_nodes"

    ! CASE 1: Linear triangle.
    allocate(nodes(2, 3))
    allocate(nodes1(2, 2))
    allocate(nodes2(2, 2))
    allocate(nodes3(2, 2))
    nodes(:, 1) = [1.0_dp, 2.0_dp]
    nodes(:, 2) = [4.0_dp, 2.5_dp]
    nodes(:, 3) = [0.0_dp, 4.0_dp]

    call compute_edge_nodes( &
         3, 2, nodes, 1, nodes1, nodes2, nodes3)
    case_success = ( &
         all(nodes1 == nodes(:, [1, 2])) .AND. &
         all(nodes2 == nodes(:, [2, 3])) .AND. &
         all(nodes3 == nodes(:, [3, 1])))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    deallocate(nodes)
    deallocate(nodes1)
    deallocate(nodes2)
    deallocate(nodes3)
    allocate(nodes(2, 6))
    allocate(nodes1(2, 3))
    allocate(nodes2(2, 3))
    allocate(nodes3(2, 3))
    nodes(:, 1) = 0
    nodes(:, 2) = [1.25_dp, 0.5_dp]
    nodes(:, 3) = [2.0_dp, 1.0_dp]
    nodes(:, 4) = [-1.5_dp, 0.75_dp]
    nodes(:, 5) = [0.0_dp, 2.0_dp]
    nodes(:, 6) = [-3.0_dp, 3.0_dp]

    call compute_edge_nodes( &
         6, 2, nodes, 2, nodes1, nodes2, nodes3)
    case_success = ( &
         all(nodes1 == nodes(:, [1, 2, 3])) .AND. &
         all(nodes2 == nodes(:, [3, 5, 6])) .AND. &
         all(nodes3 == nodes(:, [6, 4, 1])))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic triangle.
    deallocate(nodes)
    deallocate(nodes1)
    deallocate(nodes2)
    deallocate(nodes3)
    allocate(nodes(2, 10))
    allocate(nodes1(2, 4))
    allocate(nodes2(2, 4))
    allocate(nodes3(2, 4))
    nodes(:, 1) = [0.0_dp, 0.0_dp]
    nodes(:, 2) = [0.328125_dp, 0.1484375_dp]
    nodes(:, 3) = [0.65625_dp, 0.1484375_dp]
    nodes(:, 4) = [1.0_dp, 0.0_dp]
    nodes(:, 5) = [0.1484375_dp, 0.328125_dp]
    nodes(:, 6) = [0.5_dp, 0.5_dp]
    nodes(:, 7) = [1.0_dp, 0.53125_dp]
    nodes(:, 8) = [0.1484375_dp, 0.65625_dp]
    nodes(:, 9) = [0.53125_dp, 1.0_dp]
    nodes(:, 10) = [0.0_dp, 1.0_dp]

    call compute_edge_nodes( &
         10, 2, nodes, 3, nodes1, nodes2, nodes3)
    case_success = ( &
         all(nodes1 == nodes(:, [1, 2, 3, 4])) .AND. &
         all(nodes2 == nodes(:, [4, 7, 9, 10])) .AND. &
         all(nodes3 == nodes(:, [10, 8, 5, 1])))
    call print_status(name, case_id, case_success, success)

  end subroutine test_compute_edge_nodes

  subroutine test_shoelace_for_area(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(17) :: name
    real(c_double) :: nodes1(2, 2), nodes2(2, 3), nodes3(2, 4)
    real(c_double) :: nodes4(2, 5), nodes5(2, 6)
    real(c_double) :: shoelace
    logical(c_bool) :: not_implemented

    case_id = 1
    name = "shoelace_for_area"

    ! CASE 1: Linear edge.
    nodes1(:, 1) = 1
    nodes1(:, 2) = [2.0_dp, 4.0_dp]
    call shoelace_for_area(2, nodes1, shoelace, not_implemented)
    case_success = ( &
         shoelace == 1.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic edge.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [1.0_dp, 3.0_dp]
    nodes2(:, 3) = [4.0_dp, 3.0_dp]
    call shoelace_for_area(3, nodes2, shoelace, not_implemented)
    case_success = ( &
         shoelace == -3.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic edge.
    nodes3(:, 1) = 0
    nodes3(:, 2) = [1.0_dp, 9.0_dp]
    nodes3(:, 3) = [2.0_dp, -6.0_dp]
    nodes3(:, 4) = [3.0_dp, 3.0_dp]
    call shoelace_for_area(4, nodes3, shoelace, not_implemented)
    case_success = ( &
         shoelace == 0.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Quartic edge.
    nodes4(:, 1) = 0
    nodes4(:, 2) = [1.0_dp, -4.0_dp]
    nodes4(:, 3) = [2.0_dp, 3.0_dp]
    nodes4(:, 4) = [3.0_dp, -4.0_dp]
    nodes4(:, 5) = [4.0_dp, 0.0_dp]
    call shoelace_for_area(5, nodes4, shoelace, not_implemented)
    case_success = ( &
         shoelace == 4.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Unsupported degree.
    nodes5 = 1
    call shoelace_for_area(6, nodes5, shoelace, not_implemented)
    case_success = not_implemented
    call print_status(name, case_id, case_success, success)

  end subroutine test_shoelace_for_area

  subroutine test_compute_area(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(12) :: name
    type(c_ptr) :: nodes_pointers(4)
    real(c_double) :: area
    logical(c_bool) :: not_implemented
    real(c_double), target :: linear1(2, 2), linear2(2, 2), linear3(2, 2)
    real(c_double), target :: &
         quadratic1(2, 3), quadratic2(2, 3), quadratic3(2, 3)
    real(c_double), target :: quintic1(2, 6)

    case_id = 1
    name = "compute_area"

    ! CASE 1: Curved clam shell (edges are mixed degree).
    linear1(:, 1) = 0
    linear1(:, 2) = [2.0_dp, 0.0_dp]
    nodes_pointers(1) = c_loc(linear1)
    quadratic1(:, 1) = [2.0_dp, 0.0_dp]
    quadratic1(:, 2) = [1.0_dp, 3.0_dp]
    quadratic1(:, 3) = 0
    nodes_pointers(2) = c_loc(quadratic1)
    call compute_area( &
         2, [2, 3], nodes_pointers(:2), area, not_implemented)
    case_success = ( &
         area == 2.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Curved triangle (all edges quadratic).
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [1.0_dp, -1.0_dp]
    quadratic1(:, 3) = [2.0_dp, 0.0_dp]
    nodes_pointers(1) = c_loc(quadratic1)
    quadratic2(:, 1) = [2.0_dp, 0.0_dp]
    quadratic2(:, 2) = [1.5_dp, 1.5_dp]
    quadratic2(:, 3) = [0.0_dp, 2.0_dp]
    nodes_pointers(2) = c_loc(quadratic2)
    quadratic3(:, 1) = [0.0_dp, 2.0_dp]
    quadratic3(:, 2) = 1
    quadratic3(:, 3) = 0
    nodes_pointers(3) = c_loc(quadratic3)
    call compute_area( &
         3, [3, 3, 3], nodes_pointers(:3), area, not_implemented)
    case_success = ( &
         3.0_dp * area == 8.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Curved quadrilateral (edges are mixed degree).
    linear1(:, 1) = 0
    linear1(:, 2) = [1.0_dp, 0.0_dp]
    nodes_pointers(1) = c_loc(linear1)
    linear2(:, 1) = [1.0_dp, 0.0_dp]
    linear2(:, 2) = 1
    nodes_pointers(2) = c_loc(linear2)
    quadratic1(:, 1) = 1
    quadratic1(:, 2) = [0.5_dp, 2.0_dp]
    quadratic1(:, 3) = [0.0_dp, 1.0_dp]
    nodes_pointers(3) = c_loc(quadratic1)
    linear3(:, 1) = [0.0_dp, 1.0_dp]
    linear3(:, 2) = 0
    nodes_pointers(4) = c_loc(linear3)
    call compute_area( &
         4, [2, 2, 3, 2], nodes_pointers, area, not_implemented)
    case_success = ( &
         3.0_dp * area == 4.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Unsupported degree.
    quintic1 = 1
    nodes_pointers(1) = c_loc(quintic1)
    call compute_area( &
         1, [6], nodes_pointers(:1), area, not_implemented)
    case_success = not_implemented
    call print_status(name, case_id, case_success, success)

  end subroutine test_compute_area

end module test_triangle