From a78fb6a28dbfdf60640372442c884a071f8c6611 Mon Sep 17 00:00:00 2001 From: jacobwilliams Date: Sat, 6 Jan 2024 15:31:34 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20@=20jacobwil?= =?UTF-8?q?liams/bspline-fortran@8a4e171ceb4a1f5cdc7bfe42a1c8712e7493010d?= =?UTF-8?q?=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- index.html | 201 ++++++++++++++++++++++++++-- interface/b1fqad_func.html | 2 +- interface/db1ink.html | 6 +- interface/db1val.html | 6 +- module/bspline_blas_module.html | 46 +++---- module/bspline_defc_module.html | 156 +++++++++++----------- module/bspline_module.html | 2 +- module/bspline_oo_module.html | 2 +- module/bspline_sub_module.html | 202 ++++++++++++++--------------- proc/check_inputs.html | 6 +- proc/check_value.html | 6 +- proc/dasum.html | 4 +- proc/daxpy.html | 6 +- proc/db1fqad.html | 2 +- proc/db1ink_alt.html | 2 +- proc/db1ink_alt_2.html | 2 +- proc/db1ink_default.html | 2 +- proc/db1val_alt.html | 4 +- proc/db1val_default.html | 2 +- proc/db2ink.html | 2 +- proc/db2val.html | 4 +- proc/db3ink.html | 4 +- proc/db3val.html | 4 +- proc/db4ink.html | 4 +- proc/db4val.html | 4 +- proc/db5ink.html | 4 +- proc/db5val.html | 4 +- proc/db6ink.html | 6 +- proc/db6val.html | 4 +- proc/dbfqad.html | 10 +- proc/dbint4.html | 12 +- proc/dbintk.html | 10 +- proc/dbknot.html | 8 +- proc/dbndsl.html | 4 +- proc/dbnfac.html | 2 +- proc/dbnslv.html | 4 +- proc/dbsgq8.html | 8 +- proc/dbspvd.html | 14 +- proc/dbspvn.html | 14 +- proc/dbsqad.html | 8 +- proc/dbtpcf.html | 10 +- proc/dbvalu.html | 14 +- proc/dcopy.html | 6 +- proc/dcv.html | 6 +- proc/ddot.html | 6 +- proc/defc.html | 2 +- proc/defcmn.html | 2 +- proc/dfc.html | 8 +- proc/dfcmn.html | 10 +- proc/dfspvd.html | 12 +- proc/dfspvn.html | 6 +- proc/dh12.html | 4 +- proc/dhfti.html | 10 +- proc/dintrv.html | 2 +- proc/dlpdp.html | 6 +- proc/dlsei.html | 6 +- proc/dlsi.html | 6 +- proc/dnrm2.html | 4 +- proc/drotm.html | 6 +- proc/dscal.html | 4 +- proc/dsort.html | 2 +- proc/dswap.html | 6 +- proc/dwnlit.html | 10 +- proc/dwnlsm.html | 14 +- proc/dwnlt1.html | 6 +- proc/dwnlt2.html | 2 +- proc/dwnlt3.html | 8 +- proc/dwnnls.html | 12 +- proc/get_temp_x_for_extrap.html | 2 +- proc/idamax.html | 4 +- proc/sort_ascending.html | 6 +- tipuesearch/tipuesearch_content.js | 2 +- type/bspline_class.html | 10 +- 73 files changed, 596 insertions(+), 411 deletions(-) diff --git a/index.html b/index.html index b0566c7..a6dd402 100644 --- a/index.html +++ b/index.html @@ -64,8 +64,7 @@
-

BSPLINE-FORTRAN
-BSPLINE-FORTRAN -- Multidimensional B-Spline Interpolation of Data on a Regular Grid

+

BSPLINE-FORTRAN -- Multidimensional B-Spline Interpolation of Data on a Regular Grid

Find us on…

GitHub @@ -75,17 +74,203 @@

bspline-fortran

-

Brief description

-

The library provides subroutines for 1D-6D interpolation using B-splines. The code is written in modern Fortran (i.e., Fortran 2003+).

-

License

-

The bspline-fortran source code and related files and documentation are distributed under a permissive free software license (BSD-style).

-

See also

+

bspline-fortran

+

Multidimensional B-Spline Interpolation of Data on a Regular Grid.

+

Status

+

Language +GitHub release +Build Status +codecov +last-commit +DOI

+

Brief description

+

The library provides subroutines for 1D-6D interpolation and extrapolation using B-splines. The code is written in modern Fortran (i.e., Fortran 2003+). There are two ways to use the module, via a basic subroutine interface and an object-oriented interface. Both are thread safe.

+

Subroutine interface

+

The core routines for the subroutine interface are:

+
!f(x)
+subroutine db1ink(x,nx,fcn,kx,iknot,tx,bcoef,iflag)
+subroutine db1val(xval,idx,tx,nx,kx,bcoef,f,iflag,inbvx,w0,extrap)
+
+!f(x,y)
+subroutine db2ink(x,nx,y,ny,fcn,kx,ky,iknot,tx,ty,bcoef,iflag)
+subroutine db2val(xval,yval,idx,idy,tx,ty,nx,ny,kx,ky,bcoef,f,iflag,inbvx,inbvy,iloy,w1,w0,extrap)
+
+!f(x,y,z)
+subroutine db3ink(x,nx,y,ny,z,nz,fcn,kx,ky,kz,iknot,tx,ty,tz,bcoef,iflag)
+subroutine db3val(xval,yval,zval,idx,idy,idz,tx,ty,tz,nx,ny,nz,kx,ky,kz,bcoef,f,iflag,inbvx,inbvy,inbvz,iloy,iloz,w2,w1,w0,extrap)
+
+!f(x,y,z,q)
+subroutine db4ink(x,nx,y,ny,z,nz,q,nq,fcn,kx,ky,kz,kq,iknot,tx,ty,tz,tq,bcoef,iflag)
+subroutine db4val(xval,yval,zval,qval,idx,idy,idz,idq,tx,ty,tz,tq,nx,ny,nz,nq,kx,ky,kz,kq,bcoef,f,iflag,inbvx,inbvy,inbvz,inbvq,iloy,iloz,iloq,w3,w2,w1,w0,extrap)
+
+!f(x,y,z,q,r)
+subroutine db5ink(x,nx,y,ny,z,nz,q,nq,r,nr,fcn,kx,ky,kz,kq,kr,iknot,tx,ty,tz,tq,tr,bcoef,iflag)
+subroutine db5val(xval,yval,zval,qval,rval,idx,idy,idz,idq,idr,tx,ty,tz,tq,tr,nx,ny,nz,nq,nr,kx,ky,kz,kq,kr,bcoef,f,iflag,inbvx,inbvy,inbvz,inbvq,inbvr,iloy,iloz,iloq,ilor,w4,w3,w2,w1,w0,extrap)
+
+!f(x,y,z,q,r,s)
+subroutine db6ink(x,nx,y,ny,z,nz,q,nq,r,nr,s,ns,fcn,kx,ky,kz,kq,kr,ks,iknot,tx,ty,tz,tq,tr,ts,bcoef,iflag)
+subroutine db6val(xval,yval,zval,qval,rval,sval,idx,idy,idz,idq,idr,ids,tx,ty,tz,tq,tr,ts,nx,ny,nz,nq,nr,ns,kx,ky,kz,kq,kr,ks,bcoef,f,iflag,inbvx,inbvy,inbvz,inbvq,inbvr,inbvs,iloy,iloz,iloq,ilor,ilos,w5,w4,w3,w2,w1,w0,extrap)
+
+ +

The ink routines compute the interpolant coefficients, and the val routines evalute the interpolant at the specified value of each coordinate. The 2D and 3D routines are extensively refactored versions of the original routines from the NIST Core Math Library. The others are new, and are simply extensions of the same algorithm into the other dimensions.

+

Object-oriented interface

+

In addition to the main subroutines, an object-oriented interface is also provided. For example, for the 3D case:

+
type(bspline_3d) :: s
+call s%initialize(x,y,z,fcn,kx,ky,kz,iflag,extrap)
+call s%evaluate(xval,yval,zval,idx,idy,idz,f,iflag)
+call s%destroy()
+
+ +

Which uses the default "not-a-knot" end conditions. You can also specify the knot vectors (in this case, tx, ty, and tz) manually during class initialization:

+
call s%initialize(x,y,z,fcn,kx,ky,kz,tx,ty,tz,iflag,extrap)
+
+ +

The various bspline classes can also be initialized using constructors, which have similar interfaces as the initialize methods. For example:

+
type(bspline_3d) :: s
+s = bspline_3d(x,y,z,fcn,kx,ky,kz,iflag,extrap)
+
+ +

Spline order

+

The various k inputs (i.e., kx, ky, etc.) specify the spline order for each dimension. The order is the polynomial degree + 1. For example:

    -
  • This library includes the public domain DBSPLIN and DTENSBS code from the NIST Core Math Library (CMLIB).
    • +
  • k=2 : Linear
    • +
  • k=3 : Quadratic
    • +
  • k=4 : Cubic
    • +
  • etc.
    • +
+

Extrapolation

+

The library optionally supports extrapolation for points outside the range of the coefficients. This is disabled by default (in which case an error code is returned for points outside the bounds). To enable extrapolation, use the optional extrap input to the various db*val subroutines or the initialize methods from the object-oriented interface.

+

Integration

+

The library also contains routines for computing definite integrals of bsplines. There are two methods (currently only for 1D):

+
    +
  • Basic version: db1sqad (integral in the object-oriented interface) -- Computes the integral on (x1,x2) of a b-spline by applying a 2, 6, or 10 point Gauss formula on subintervals of (x1,x2). This is only valid for orders <= 20.
    • +
  • More general version: db1fqad (fintegral in the object-oriented interface) -- Computes the integral on (x1,x2) of a product of a user-defined function fun(x) and the ith derivative of a b-spline with an adaptive 8-point Legendre-Gauss algorithm.
+

Note that extrapolation is not currently supported for these.

+

Least squares fitting

+

The BSpline-Fortran library also exports the defc subroutine, which can be used to fit B-spline polynomials to 1D data using a weighted least squares method. The dfc subroutine also allows for equality and inequality constraints to be imposed on the fitted curve. These procedures are not yet available in the object oriented interface.

+

Examples

+

See the examples for more details. Note that, to compile and run some of the test programs, the pyplot-fortran library (which is used to generate plots) is required. This will automatically be downloaded by FPM.

+

Compiling

+

The library can be compiled with recent versions the Intel Fortran Compiler and GFortran (and presumably any other Fortran compiler that supports modern standards).

+

FPM

+

A fmp.toml file is provided for compiling bspline-fortran with the Fortran Package Manager. For example, to build:

+
fpm build --profile release
+
+ +

By default, the library is built with double precision (real64) real values and single precision (int32) integer values. Explicitly specifying the real or integer kinds can be done using the following processor flags:

+ + + + + + + + + + + + + + + + + + + + + + + + + +
Preprocessor flagKindNumber of bytes
REAL32real(kind=real32)4
REAL64real(kind=real64)8
REAL128real(kind=real128)16
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Preprocessor flagKindNumber of bytes
INT8integer(kind=int8)1
INT16integer(kind=int16)2
INT32integer(kind=int32)4
INT64integer(kind=int64)8
+

For example, to build a single precision version of the library, use:

+
fpm build --profile release --flag "-DREAL32"
+
+ +

To run the unit tests:

+
fpm test --profile release
+
+ +

To use bspline-fortran within your fpm project, add the following to your fpm.toml file:

+
[dependencies]
+bspline-fortran = { git="https://github.com/jacobwilliams/bspline-fortran.git" }
+
+ +

or, to use a specific version:

+
[dependencies]
+bspline-fortran = { git="https://github.com/jacobwilliams/bspline-fortran.git", tag = "7.3.0"  }
+
+ +

CMake

+

A basic CMake configuration file is also included. For example, to build a static library:

+
 mkdir build
+ cd build
+ cmake ..
+ make
+
+ +

Or, to build a shared library:

+
 cmake -DBUILD_SHARED_LIBS=ON ..
+
+ +

For a debug build:

+
 cmake -DCMAKE_BUILD_TYPE=DEBUG ..
+
+ +

Dependencies

+

The library requires some BLAS routines, which are included. However, the user may also choose to link to an external BLAS library. This can be done by using the HAS_BLAS compiler directive. For example:

+
fpm build --compiler gfortran --flag "-DHAS_BLAS -lblas"
+
+ +

However, note that an external BLAS can only be used if the library is compiled with double precision (real64) reals.

+

Documentation

+

The latest API documentation can be found here. This was generated from the source code using FORD (i.e. by running ford ford.md).

+

License

+

The bspline-fortran source code and related files and documentation are distributed under a permissive free software license (BSD-style).

Keywords

  • Bspline, spline, interpolation, data fitting, multivariate interpolation, multidimensional interpolation, integration
    • +
+

See also

+
    +
  • This library includes the public domain DBSPLIN and DTENSBS code from the NIST Core Math Library (CMLIB).
    • +
  • SPLPAK Multidimensional least-squares cubic spline fitting
    • +
  • FINTERP Multidimensional Linear Interpolation with Modern Fortran
    • +
  • PCHIP Piecewise Cubic Hermite Interpolation.
    • +
  • Regridpack Linear or cubic interpolation for 1D-4D grids.
diff --git a/interface/b1fqad_func.html b/interface/b1fqad_func.html index 1229e49..00996c8 100644 --- a/interface/b1fqad_func.html +++ b/interface/b1fqad_func.html @@ -156,7 +156,7 @@

Arguments

- + real(kind=wp), intent(in) diff --git a/interface/db1ink.html b/interface/db1ink.html index 8243273..75787fd 100644 --- a/interface/db1ink.html +++ b/interface/db1ink.html @@ -696,7 +696,7 @@

Arguments

- + real(kind=wp), intent(in), @@ -845,7 +845,7 @@

Arguments

- + real(kind=wp), intent(in), @@ -1055,7 +1055,7 @@

Arguments

- + real(kind=wp), intent(in), diff --git a/interface/db1val.html b/interface/db1val.html index f233501..d59e145 100644 --- a/interface/db1val.html +++ b/interface/db1val.html @@ -503,7 +503,7 @@

Arguments

- + real(kind=wp), intent(in) @@ -701,7 +701,7 @@

Arguments

- + real(kind=wp), intent(in) @@ -764,7 +764,7 @@

Arguments

- + integer(kind=ip), intent(in) diff --git a/module/bspline_blas_module.html b/module/bspline_blas_module.html index 7275c52..2ec5354 100644 --- a/module/bspline_blas_module.html +++ b/module/bspline_blas_module.html @@ -469,7 +469,7 @@

Arguments

- + integer(kind=ip) @@ -484,7 +484,7 @@

Arguments

- + real(kind=wp) @@ -514,7 +514,7 @@

Arguments

- + real(kind=wp) @@ -574,7 +574,7 @@

Arguments

- + integer(kind=ip) @@ -589,7 +589,7 @@

Arguments

- + real(kind=wp) @@ -649,7 +649,7 @@

Arguments

- + integer(kind=ip) @@ -664,7 +664,7 @@

Arguments

- + real(kind=wp) @@ -724,7 +724,7 @@

Arguments

- + integer(kind=ip) @@ -739,7 +739,7 @@

Arguments

- + real(kind=wp) @@ -805,7 +805,7 @@

Arguments

- + integer(kind=ip) @@ -835,7 +835,7 @@

Arguments

- + real(kind=wp) @@ -865,7 +865,7 @@

Arguments

- + real(kind=wp) @@ -921,7 +921,7 @@

Arguments

- + integer(kind=ip) @@ -936,7 +936,7 @@

Arguments

- + real(kind=wp) @@ -966,7 +966,7 @@

Arguments

- + real(kind=wp) @@ -1022,7 +1022,7 @@

Arguments

- + integer(kind=ip) @@ -1052,7 +1052,7 @@

Arguments

- + real(kind=wp) @@ -1108,7 +1108,7 @@

Arguments

- + integer(kind=ip) @@ -1123,7 +1123,7 @@

Arguments

- + real(kind=wp) @@ -1153,7 +1153,7 @@

Arguments

- + real(kind=wp) @@ -1208,7 +1208,7 @@

Arguments

- + integer(kind=ip) @@ -1223,7 +1223,7 @@

Arguments

- + real(kind=wp) @@ -1253,7 +1253,7 @@

Arguments

- + real(kind=wp) diff --git a/module/bspline_defc_module.html b/module/bspline_defc_module.html index a5da102..932ac9a 100644 --- a/module/bspline_defc_module.html +++ b/module/bspline_defc_module.html @@ -594,7 +594,7 @@

Arguments

- + real(kind=wp) @@ -685,7 +685,7 @@

Arguments

- + real(kind=wp), intent(in) @@ -700,7 +700,7 @@

Arguments

- + integer, intent(in) @@ -784,7 +784,7 @@

Arguments

- + real(kind=wp) @@ -1048,7 +1048,7 @@

Arguments

- + real(kind=wp) @@ -1338,7 +1338,7 @@

Arguments

- + real(kind=wp) @@ -1657,7 +1657,7 @@

Arguments

- + real(kind=wp), intent(inout) @@ -1667,12 +1667,12 @@

Arguments

:: x(*) -

X(N)

Read more… +

X(N)

Read more… - + integer, intent(in) @@ -1734,7 +1734,7 @@

Arguments

- + real(kind=wp), intent(in) @@ -1779,7 +1779,7 @@

Arguments

- + real(kind=wp), intent(in) @@ -1824,7 +1824,7 @@

Arguments

- + integer, intent(inout) @@ -1942,7 +1942,7 @@

Arguments

- + integer, intent(in) @@ -2007,7 +2007,7 @@

Arguments

- + real(kind=wp), intent(inout) @@ -2098,7 +2098,7 @@

Arguments

- + integer, intent(in) @@ -2186,7 +2186,7 @@

Arguments

- + integer, intent(in) @@ -2201,7 +2201,7 @@

Arguments

- + real(kind=wp), intent(inout), @@ -2216,7 +2216,7 @@

Arguments

- + real(kind=wp), intent(inout), @@ -2261,7 +2261,7 @@

Arguments

- + integer, intent(in) @@ -2441,7 +2441,7 @@

Arguments

- + integer, intent(in) @@ -2457,7 +2457,7 @@

Arguments

of the B-spline. (Any non-negative value of J < NORD is permitted. In particular the value J=0 refers to the B-spline itself.) - For this I-th constraint, set

Read more… + For this I-th constraint, set

Read more… @@ -2503,7 +2503,7 @@

Arguments

- + real(kind=wp) @@ -2515,12 +2515,12 @@

Arguments

real work array of length IW(1). The contents of W(*) must not be modified by the - user if the variance function is desired.

Read more… + user if the variance function is desired.

Read more… - + integer @@ -2530,7 +2530,7 @@

Arguments

:: iw(*) -

integer work array of length IW(2)

Read more… +

integer work array of length IW(2)

Read more… @@ -2561,7 +2561,7 @@

Arguments

- + integer @@ -2711,7 +2711,7 @@

Arguments

- + integer @@ -2846,7 +2846,7 @@

Arguments

- + real(kind=wp) @@ -2876,7 +2876,7 @@

Arguments

- + real(kind=wp) @@ -2891,7 +2891,7 @@

Arguments

- + integer @@ -2931,7 +2931,7 @@

Arguments

- + real(kind=wp) @@ -2946,7 +2946,7 @@

Arguments

- + integer @@ -2961,7 +2961,7 @@

Arguments

- + real(kind=wp) @@ -2976,7 +2976,7 @@

Arguments

- + integer @@ -2991,7 +2991,7 @@

Arguments

- + real(kind=wp) @@ -3006,7 +3006,7 @@

Arguments

- + integer @@ -3048,7 +3048,7 @@

Arguments

- + real(kind=wp), intent(inout) @@ -3065,7 +3065,7 @@

Arguments

A(,) is MDA, which must satisfy MDA>=M Either M>=N or M<N is permitted. There is no restriction on the rank of A. The -condition MDA<M is considered an error.

Read more… +condition MDA<M is considered an error.

Read more… @@ -3085,7 +3085,7 @@

Arguments

- + integer, intent(in) @@ -3100,7 +3100,7 @@

Arguments

- + integer, intent(in) @@ -3115,7 +3115,7 @@

Arguments

- + real(kind=wp), intent(inout) @@ -3137,7 +3137,7 @@

Arguments

be either doubly or singly subscripted. In the latter case the value of MDB is arbitrary but it should be set to some valid integer -value such as MDB = M.

Read more… +value such as MDB = M.

Read more… @@ -3223,7 +3223,7 @@

Arguments

- + real(kind=wp) @@ -3312,7 +3312,7 @@

Arguments

- + real(kind=wp) @@ -3342,7 +3342,7 @@

Arguments

- + integer @@ -3402,7 +3402,7 @@

Arguments

- + real(kind=wp) @@ -3506,7 +3506,7 @@

Arguments

- + real(kind=wp) @@ -3581,7 +3581,7 @@

Arguments

- + integer @@ -3611,7 +3611,7 @@

Arguments

- + real(kind=wp) @@ -3727,7 +3727,7 @@

Arguments

- + real(kind=wp) @@ -3737,7 +3737,7 @@

Arguments

:: w(mdw,*) -

W(*,*) contains:

Read more… +

W(*,*) contains:

Read more… @@ -3787,7 +3787,7 @@

Arguments

- + integer, intent(in) @@ -3817,7 +3817,7 @@

Arguments

- + real(kind=wp), intent(out) @@ -3919,7 +3919,7 @@

Arguments

- + real(kind=wp) @@ -3949,7 +3949,7 @@

Arguments

- + integer @@ -3964,7 +3964,7 @@

Arguments

- + integer @@ -3979,7 +3979,7 @@

Arguments

- + integer @@ -4024,7 +4024,7 @@

Arguments

- + real(kind=wp) @@ -4140,7 +4140,7 @@

Arguments

- + real(kind=wp) @@ -4200,7 +4200,7 @@

Arguments

- + integer @@ -4215,7 +4215,7 @@

Arguments

- + integer @@ -4245,7 +4245,7 @@

Arguments

- + real(kind=wp) @@ -4335,7 +4335,7 @@

Arguments

- + real(kind=wp) @@ -4365,7 +4365,7 @@

Arguments

- + real(kind=wp) @@ -4380,7 +4380,7 @@

Arguments

- + real(kind=wp) @@ -4437,7 +4437,7 @@

Arguments

- + integer @@ -4557,7 +4557,7 @@

Arguments

- + real(kind=wp) @@ -4587,7 +4587,7 @@

Arguments

- + real(kind=wp) @@ -4629,7 +4629,7 @@

Arguments

- + integer, intent(in) @@ -4659,7 +4659,7 @@

Arguments

- + integer, intent(in) @@ -4704,7 +4704,7 @@

Arguments

- + real(kind=wp), intent(inout) @@ -4719,7 +4719,7 @@

Arguments

- + real(kind=wp), intent(inout) @@ -4763,7 +4763,7 @@

Arguments

- + real(kind=wp) @@ -4823,7 +4823,7 @@

Arguments

- + integer @@ -4838,7 +4838,7 @@

Arguments

- + integer @@ -4868,7 +4868,7 @@

Arguments

- + real(kind=wp) @@ -4913,7 +4913,7 @@

Arguments

- + integer @@ -4928,7 +4928,7 @@

Arguments

- + real(kind=wp) diff --git a/module/bspline_module.html b/module/bspline_module.html index ece26f1..cf7b3db 100644 --- a/module/bspline_module.html +++ b/module/bspline_module.html @@ -147,9 +147,9 @@

Uses

    • diff --git a/module/bspline_oo_module.html b/module/bspline_oo_module.html index 3bdd571..23ba320 100644 --- a/module/bspline_oo_module.html +++ b/module/bspline_oo_module.html @@ -288,8 +288,8 @@

    Uses

      • diff --git a/module/bspline_sub_module.html b/module/bspline_sub_module.html index ec52031..8c2075e 100644 --- a/module/bspline_sub_module.html +++ b/module/bspline_sub_module.html @@ -753,7 +753,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -913,7 +913,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -1134,7 +1134,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -1392,7 +1392,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -1589,7 +1589,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -1652,7 +1652,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -1812,7 +1812,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -1865,7 +1865,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -1880,7 +1880,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -1895,7 +1895,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -1957,7 +1957,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -2103,7 +2103,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -2252,7 +2252,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -2462,7 +2462,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -2688,7 +2688,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -2886,7 +2886,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -2949,7 +2949,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -3387,7 +3387,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -3479,7 +3479,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -3694,7 +3694,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -3710,7 +3710,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -4029,7 +4029,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -4089,7 +4089,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -4306,7 +4306,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -4322,7 +4322,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -4768,7 +4768,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -4828,7 +4828,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -5110,7 +5110,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -5126,7 +5126,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -5700,7 +5700,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -5760,7 +5760,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -6105,7 +6105,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -6121,7 +6121,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -6825,7 +6825,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -6887,7 +6887,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -6980,7 +6980,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -7300,7 +7300,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -7316,7 +7316,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -8361,7 +8361,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -8391,7 +8391,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -8436,7 +8436,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -8784,7 +8784,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -8799,7 +8799,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -8814,7 +8814,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -8829,7 +8829,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -8874,7 +8874,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -8889,7 +8889,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -8949,7 +8949,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -8964,7 +8964,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -8994,7 +8994,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -9052,7 +9052,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -9084,7 +9084,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -9095,12 +9095,12 @@

      Arguments

      t

      knot vector of length n+k -since t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k)

      Read more… +since t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k)

      Read more… - + integer(kind=ip), intent(in) @@ -9115,7 +9115,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -9167,7 +9167,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -9224,7 +9224,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -9341,7 +9341,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -9421,7 +9421,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -9431,7 +9431,7 @@

      Arguments

      :: b -Read more… +Read more… @@ -9470,7 +9470,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -9503,7 +9503,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -9536,7 +9536,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -9551,7 +9551,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -9566,7 +9566,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -9581,7 +9581,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -9596,7 +9596,7 @@

      Arguments

      - + integer(kind=ip), intent(inout) @@ -9663,7 +9663,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -9678,7 +9678,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -9693,7 +9693,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -9709,7 +9709,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -9724,7 +9724,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -9740,7 +9740,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -9775,7 +9775,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -9932,7 +9932,7 @@

      Arguments

      - + integer(kind=ip), intent(out) @@ -10005,7 +10005,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -10036,7 +10036,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10158,7 +10158,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -10188,7 +10188,7 @@

      Arguments

      - + integer(kind=ip), intent(out) @@ -10203,7 +10203,7 @@

      Arguments

      - + integer(kind=ip), intent(out) @@ -10218,7 +10218,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -10283,7 +10283,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -10300,7 +10300,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10315,7 +10315,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10331,7 +10331,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -10347,7 +10347,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10378,7 +10378,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -10395,7 +10395,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -10454,7 +10454,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -10484,7 +10484,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10499,7 +10499,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10561,7 +10561,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -10637,7 +10637,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -10667,7 +10667,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10682,7 +10682,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10743,7 +10743,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -10791,7 +10791,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -10880,7 +10880,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -10925,7 +10925,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -10940,7 +10940,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -11020,7 +11020,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/check_inputs.html b/proc/check_inputs.html index c6a3887..8597363 100644 --- a/proc/check_inputs.html +++ b/proc/check_inputs.html @@ -382,7 +382,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -412,7 +412,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -457,7 +457,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/check_value.html b/proc/check_value.html index e244344..e79bb6b 100644 --- a/proc/check_value.html +++ b/proc/check_value.html @@ -163,7 +163,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -178,7 +178,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -193,7 +193,7 @@

      Arguments

      - + integer(kind=ip), intent(in) diff --git a/proc/dasum.html b/proc/dasum.html index ce998b6..a9bc58a 100644 --- a/proc/dasum.html +++ b/proc/dasum.html @@ -162,7 +162,7 @@

      Arguments

      - + integer(kind=ip) @@ -177,7 +177,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/daxpy.html b/proc/daxpy.html index 24add13..14609d9 100644 --- a/proc/daxpy.html +++ b/proc/daxpy.html @@ -163,7 +163,7 @@

      Arguments

      - + integer(kind=ip) @@ -193,7 +193,7 @@

      Arguments

      - + real(kind=wp) @@ -223,7 +223,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/db1fqad.html b/proc/db1fqad.html index d069336..859fced 100644 --- a/proc/db1fqad.html +++ b/proc/db1fqad.html @@ -297,7 +297,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/db1ink_alt.html b/proc/db1ink_alt.html index 619aaae..877a322 100644 --- a/proc/db1ink_alt.html +++ b/proc/db1ink_alt.html @@ -174,7 +174,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db1ink_alt_2.html b/proc/db1ink_alt_2.html index d8dd2bf..fcb4971 100644 --- a/proc/db1ink_alt_2.html +++ b/proc/db1ink_alt_2.html @@ -175,7 +175,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db1ink_default.html b/proc/db1ink_default.html index 5c6861b..b56cd2f 100644 --- a/proc/db1ink_default.html +++ b/proc/db1ink_default.html @@ -170,7 +170,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db1val_alt.html b/proc/db1val_alt.html index 0d29adf..9357f8b 100644 --- a/proc/db1val_alt.html +++ b/proc/db1val_alt.html @@ -162,7 +162,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -225,7 +225,7 @@

      Arguments

      - + integer(kind=ip), intent(in) diff --git a/proc/db1val_default.html b/proc/db1val_default.html index 1ad1345..eb3fa2c 100644 --- a/proc/db1val_default.html +++ b/proc/db1val_default.html @@ -184,7 +184,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/db2ink.html b/proc/db2ink.html index 59395b5..d5d97d7 100644 --- a/proc/db2ink.html +++ b/proc/db2ink.html @@ -206,7 +206,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db2val.html b/proc/db2val.html index 6ae59bd..d3e7699 100644 --- a/proc/db2val.html +++ b/proc/db2val.html @@ -190,7 +190,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -206,7 +206,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/db3ink.html b/proc/db3ink.html index 4d41f66..18b09ff 100644 --- a/proc/db3ink.html +++ b/proc/db3ink.html @@ -214,7 +214,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -274,7 +274,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db3val.html b/proc/db3val.html index 1d7cfa2..56c2fcb 100644 --- a/proc/db3val.html +++ b/proc/db3val.html @@ -194,7 +194,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -210,7 +210,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/db4ink.html b/proc/db4ink.html index 1644a96..29c32a5 100644 --- a/proc/db4ink.html +++ b/proc/db4ink.html @@ -173,7 +173,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -233,7 +233,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db4val.html b/proc/db4val.html index 8c08946..f3a43e5 100644 --- a/proc/db4val.html +++ b/proc/db4val.html @@ -172,7 +172,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -188,7 +188,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/db5ink.html b/proc/db5ink.html index 61ca134..93a901a 100644 --- a/proc/db5ink.html +++ b/proc/db5ink.html @@ -178,7 +178,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -238,7 +238,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db5val.html b/proc/db5val.html index d7e6d42..4c0543e 100644 --- a/proc/db5val.html +++ b/proc/db5val.html @@ -172,7 +172,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -188,7 +188,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/db6ink.html b/proc/db6ink.html index c55e316..5aa144c 100644 --- a/proc/db6ink.html +++ b/proc/db6ink.html @@ -177,7 +177,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -239,7 +239,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -332,7 +332,7 @@

      Arguments

      - + real(kind=wp), intent(in), diff --git a/proc/db6val.html b/proc/db6val.html index 390d8bd..162854d 100644 --- a/proc/db6val.html +++ b/proc/db6val.html @@ -172,7 +172,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -188,7 +188,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/dbfqad.html b/proc/dbfqad.html index 33584df..c43f7fe 100644 --- a/proc/dbfqad.html +++ b/proc/dbfqad.html @@ -210,7 +210,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -240,7 +240,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -255,7 +255,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -316,7 +316,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -374,7 +374,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dbint4.html b/proc/dbint4.html index 6a1a764..210d223 100644 --- a/proc/dbint4.html +++ b/proc/dbint4.html @@ -202,7 +202,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -233,7 +233,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -371,7 +371,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -401,7 +401,7 @@

      Arguments

      - + integer(kind=ip), intent(out) @@ -416,7 +416,7 @@

      Arguments

      - + integer(kind=ip), intent(out) @@ -431,7 +431,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dbintk.html b/proc/dbintk.html index b53fee0..0423a57 100644 --- a/proc/dbintk.html +++ b/proc/dbintk.html @@ -195,7 +195,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -227,7 +227,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -247,7 +247,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -262,7 +262,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -314,7 +314,7 @@

      Arguments

      - + real(kind=wp), intent(out), diff --git a/proc/dbknot.html b/proc/dbknot.html index 2ccf6de..e1d26af 100644 --- a/proc/dbknot.html +++ b/proc/dbknot.html @@ -172,7 +172,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -187,7 +187,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -202,7 +202,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -217,7 +217,7 @@

      Arguments

      - + real(kind=wp), intent(out), diff --git a/proc/dbndsl.html b/proc/dbndsl.html index 4d8c4b3..68a584a 100644 --- a/proc/dbndsl.html +++ b/proc/dbndsl.html @@ -284,7 +284,7 @@

      Arguments

      - + real(kind=wp), intent(inout) @@ -306,7 +306,7 @@

      Arguments

      - + integer, intent(in) diff --git a/proc/dbnfac.html b/proc/dbnfac.html index 008ea6c..2348de5 100644 --- a/proc/dbnfac.html +++ b/proc/dbnfac.html @@ -216,7 +216,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dbnslv.html b/proc/dbnslv.html index 36a522c..ca2dca7 100644 --- a/proc/dbnslv.html +++ b/proc/dbnslv.html @@ -174,7 +174,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -254,7 +254,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dbsgq8.html b/proc/dbsgq8.html index c223ba3..e1a382c 100644 --- a/proc/dbsgq8.html +++ b/proc/dbsgq8.html @@ -228,7 +228,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -273,7 +273,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -288,7 +288,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -384,7 +384,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dbspvd.html b/proc/dbspvd.html index d743fb8..8f713f8 100644 --- a/proc/dbspvd.html +++ b/proc/dbspvd.html @@ -190,7 +190,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -207,7 +207,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -222,7 +222,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -238,7 +238,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -254,7 +254,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -285,7 +285,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -302,7 +302,7 @@

      Arguments

      - + real(kind=wp), intent(out), diff --git a/proc/dbspvn.html b/proc/dbspvn.html index 0021bdd..8261621 100644 --- a/proc/dbspvn.html +++ b/proc/dbspvn.html @@ -184,7 +184,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -217,7 +217,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -250,7 +250,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -265,7 +265,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -280,7 +280,7 @@

      Arguments

      - + real(kind=wp), intent(out), @@ -295,7 +295,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -310,7 +310,7 @@

      Arguments

      - + integer(kind=ip), intent(inout) diff --git a/proc/dbsqad.html b/proc/dbsqad.html index dd6e964..9fe4e20 100644 --- a/proc/dbsqad.html +++ b/proc/dbsqad.html @@ -197,7 +197,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -227,7 +227,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -242,7 +242,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -304,7 +304,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dbtpcf.html b/proc/dbtpcf.html index c76b950..c09ffcb 100644 --- a/proc/dbtpcf.html +++ b/proc/dbtpcf.html @@ -171,7 +171,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -186,7 +186,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -246,7 +246,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -261,7 +261,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -291,7 +291,7 @@

      Arguments

      - + real(kind=wp), intent(out), diff --git a/proc/dbvalu.html b/proc/dbvalu.html index 50129d5..d30df64 100644 --- a/proc/dbvalu.html +++ b/proc/dbvalu.html @@ -185,7 +185,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -200,7 +200,7 @@

      Arguments

      - + real(kind=wp), intent(in), @@ -215,7 +215,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -231,7 +231,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -246,7 +246,7 @@

      Arguments

      - + integer(kind=ip), intent(in) @@ -262,7 +262,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -297,7 +297,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/proc/dcopy.html b/proc/dcopy.html index 82fa031..6aedadd 100644 --- a/proc/dcopy.html +++ b/proc/dcopy.html @@ -163,7 +163,7 @@

      Arguments

      - + integer(kind=ip) @@ -178,7 +178,7 @@

      Arguments

      - + real(kind=wp) @@ -208,7 +208,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dcv.html b/proc/dcv.html index bbe50ae..c0440db 100644 --- a/proc/dcv.html +++ b/proc/dcv.html @@ -210,7 +210,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -225,7 +225,7 @@

      Arguments

      - + integer, intent(in) @@ -313,7 +313,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/ddot.html b/proc/ddot.html index fa6ee9a..76e39a3 100644 --- a/proc/ddot.html +++ b/proc/ddot.html @@ -163,7 +163,7 @@

      Arguments

      - + integer(kind=ip) @@ -178,7 +178,7 @@

      Arguments

      - + real(kind=wp) @@ -208,7 +208,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/defc.html b/proc/defc.html index 98bbacb..bdc2d99 100644 --- a/proc/defc.html +++ b/proc/defc.html @@ -461,7 +461,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/defcmn.html b/proc/defcmn.html index e444fa5..aae59dd 100644 --- a/proc/defcmn.html +++ b/proc/defcmn.html @@ -416,7 +416,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dfc.html b/proc/dfc.html index bc0abaa..40aeec4 100644 --- a/proc/dfc.html +++ b/proc/dfc.html @@ -218,7 +218,7 @@

      Arguments

      - + integer, intent(in) @@ -398,7 +398,7 @@

      Arguments

      - + integer, intent(in) @@ -558,7 +558,7 @@

      Arguments

      - + real(kind=wp) @@ -602,7 +602,7 @@

      Arguments

      - + integer diff --git a/proc/dfcmn.html b/proc/dfcmn.html index 41d9b70..2a48f6c 100644 --- a/proc/dfcmn.html +++ b/proc/dfcmn.html @@ -174,7 +174,7 @@

      Arguments

      - + integer @@ -324,7 +324,7 @@

      Arguments

      - + integer @@ -459,7 +459,7 @@

      Arguments

      - + real(kind=wp) @@ -489,7 +489,7 @@

      Arguments

      - + real(kind=wp) @@ -504,7 +504,7 @@

      Arguments

      - + integer diff --git a/proc/dfspvd.html b/proc/dfspvd.html index 1dd4c93..b7d9eaa 100644 --- a/proc/dfspvd.html +++ b/proc/dfspvd.html @@ -174,7 +174,7 @@

      Arguments

      - + real(kind=wp) @@ -189,7 +189,7 @@

      Arguments

      - + integer @@ -204,7 +204,7 @@

      Arguments

      - + real(kind=wp) @@ -219,7 +219,7 @@

      Arguments

      - + integer @@ -234,7 +234,7 @@

      Arguments

      - + real(kind=wp) @@ -249,7 +249,7 @@

      Arguments

      - + integer diff --git a/proc/dfspvn.html b/proc/dfspvn.html index 2d20200..b2256f1 100644 --- a/proc/dfspvn.html +++ b/proc/dfspvn.html @@ -170,7 +170,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -215,7 +215,7 @@

      Arguments

      - + real(kind=wp), intent(in) @@ -260,7 +260,7 @@

      Arguments

      - + integer, intent(inout) diff --git a/proc/dh12.html b/proc/dh12.html index d428b7a..0570fea 100644 --- a/proc/dh12.html +++ b/proc/dh12.html @@ -224,7 +224,7 @@

      Arguments

      - + integer, intent(in) @@ -289,7 +289,7 @@

      Arguments

      - + real(kind=wp), intent(inout) diff --git a/proc/dhfti.html b/proc/dhfti.html index af8ccc6..8ed96c3 100644 --- a/proc/dhfti.html +++ b/proc/dhfti.html @@ -212,7 +212,7 @@

      Arguments

      - + real(kind=wp), intent(inout) @@ -252,7 +252,7 @@

      Arguments

      - + integer, intent(in) @@ -267,7 +267,7 @@

      Arguments

      - + integer, intent(in) @@ -282,7 +282,7 @@

      Arguments

      - + real(kind=wp), intent(inout) @@ -394,7 +394,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dintrv.html b/proc/dintrv.html index 83d9737..27178ee 100644 --- a/proc/dintrv.html +++ b/proc/dintrv.html @@ -249,7 +249,7 @@

      Arguments

      - + integer(kind=ip), intent(out) diff --git a/proc/dlpdp.html b/proc/dlpdp.html index 515f60b..fb233af 100644 --- a/proc/dlpdp.html +++ b/proc/dlpdp.html @@ -186,7 +186,7 @@

      Arguments

      - + real(kind=wp) @@ -216,7 +216,7 @@

      Arguments

      - + integer @@ -276,7 +276,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dlsei.html b/proc/dlsei.html index a3518b1..df6a55d 100644 --- a/proc/dlsei.html +++ b/proc/dlsei.html @@ -521,7 +521,7 @@

      Arguments

      - + real(kind=wp) @@ -596,7 +596,7 @@

      Arguments

      - + integer @@ -626,7 +626,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dlsi.html b/proc/dlsi.html index 717dde1..729910a 100644 --- a/proc/dlsi.html +++ b/proc/dlsi.html @@ -181,7 +181,7 @@

      Arguments

      - + real(kind=wp) @@ -247,7 +247,7 @@

      Arguments

      - + integer, intent(in) @@ -277,7 +277,7 @@

      Arguments

      - + real(kind=wp), intent(out) diff --git a/proc/dnrm2.html b/proc/dnrm2.html index 06d39fd..a2ab94c 100644 --- a/proc/dnrm2.html +++ b/proc/dnrm2.html @@ -156,7 +156,7 @@

      Arguments

      - + integer(kind=ip) @@ -171,7 +171,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/drotm.html b/proc/drotm.html index 9c104c4..4ff6683 100644 --- a/proc/drotm.html +++ b/proc/drotm.html @@ -162,7 +162,7 @@

      Arguments

      - + integer(kind=ip) @@ -177,7 +177,7 @@

      Arguments

      - + real(kind=wp) @@ -207,7 +207,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dscal.html b/proc/dscal.html index 030e8c2..0280235 100644 --- a/proc/dscal.html +++ b/proc/dscal.html @@ -163,7 +163,7 @@

      Arguments

      - + integer(kind=ip) @@ -193,7 +193,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dsort.html b/proc/dsort.html index 98d6d46..68da9f2 100644 --- a/proc/dsort.html +++ b/proc/dsort.html @@ -169,7 +169,7 @@

      Arguments

      - + integer, intent(in) diff --git a/proc/dswap.html b/proc/dswap.html index b3e718f..6b40d68 100644 --- a/proc/dswap.html +++ b/proc/dswap.html @@ -163,7 +163,7 @@

      Arguments

      - + integer(kind=ip) @@ -178,7 +178,7 @@

      Arguments

      - + real(kind=wp) @@ -208,7 +208,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dwnlit.html b/proc/dwnlit.html index 0798bbc..c2216df 100644 --- a/proc/dwnlit.html +++ b/proc/dwnlit.html @@ -177,7 +177,7 @@

      Arguments

      - + real(kind=wp) @@ -207,7 +207,7 @@

      Arguments

      - + integer @@ -222,7 +222,7 @@

      Arguments

      - + integer @@ -237,7 +237,7 @@

      Arguments

      - + integer @@ -282,7 +282,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dwnlsm.html b/proc/dwnlsm.html index c806579..f3e0c24 100644 --- a/proc/dwnlsm.html +++ b/proc/dwnlsm.html @@ -215,7 +215,7 @@

      Arguments

      - + real(kind=wp) @@ -275,7 +275,7 @@

      Arguments

      - + integer @@ -290,7 +290,7 @@

      Arguments

      - + integer @@ -320,7 +320,7 @@

      Arguments

      - + real(kind=wp) @@ -410,7 +410,7 @@

      Arguments

      - + real(kind=wp) @@ -440,7 +440,7 @@

      Arguments

      - + real(kind=wp) @@ -455,7 +455,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dwnlt1.html b/proc/dwnlt1.html index 7d559cf..4d349bc 100644 --- a/proc/dwnlt1.html +++ b/proc/dwnlt1.html @@ -170,7 +170,7 @@

      Arguments

      - + integer @@ -290,7 +290,7 @@

      Arguments

      - + real(kind=wp) @@ -320,7 +320,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dwnlt2.html b/proc/dwnlt2.html index 8da0c31..bd09bb0 100644 --- a/proc/dwnlt2.html +++ b/proc/dwnlt2.html @@ -232,7 +232,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/dwnlt3.html b/proc/dwnlt3.html index 1d7d4ce..c1f4e58 100644 --- a/proc/dwnlt3.html +++ b/proc/dwnlt3.html @@ -170,7 +170,7 @@

      Arguments

      - + integer, intent(in) @@ -200,7 +200,7 @@

      Arguments

      - + integer, intent(in) @@ -245,7 +245,7 @@

      Arguments

      - + real(kind=wp), intent(inout) @@ -260,7 +260,7 @@

      Arguments

      - + real(kind=wp), intent(inout) diff --git a/proc/dwnnls.html b/proc/dwnnls.html index 713c265..dd187b3 100644 --- a/proc/dwnnls.html +++ b/proc/dwnnls.html @@ -408,7 +408,7 @@

      Arguments

      - + real(kind=wp) @@ -468,7 +468,7 @@

      Arguments

      - + integer @@ -483,7 +483,7 @@

      Arguments

      - + integer @@ -513,7 +513,7 @@

      Arguments

      - + real(kind=wp) @@ -558,7 +558,7 @@

      Arguments

      - + integer @@ -573,7 +573,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/get_temp_x_for_extrap.html b/proc/get_temp_x_for_extrap.html index f128da7..9c22370 100644 --- a/proc/get_temp_x_for_extrap.html +++ b/proc/get_temp_x_for_extrap.html @@ -166,7 +166,7 @@

      Arguments

      - + real(kind=wp), intent(in) diff --git a/proc/idamax.html b/proc/idamax.html index abcd42b..6335748 100644 --- a/proc/idamax.html +++ b/proc/idamax.html @@ -162,7 +162,7 @@

      Arguments

      - + integer(kind=ip) @@ -177,7 +177,7 @@

      Arguments

      - + real(kind=wp) diff --git a/proc/sort_ascending.html b/proc/sort_ascending.html index ae0c423..e4df894 100644 --- a/proc/sort_ascending.html +++ b/proc/sort_ascending.html @@ -167,7 +167,7 @@

      Arguments

      - + integer, intent(in) @@ -182,7 +182,7 @@

      Arguments

      - + real(kind=wp), intent(inout), @@ -197,7 +197,7 @@

      Arguments

      - + real(kind=wp), intent(inout), diff --git a/tipuesearch/tipuesearch_content.js b/tipuesearch/tipuesearch_content.js index 2283610..2a65d3b 100644 --- a/tipuesearch/tipuesearch_content.js +++ b/tipuesearch/tipuesearch_content.js @@ -1 +1 @@ -var tipuesearch = {"pages":[{"title":" bspline-fortran ","text":"bspline-fortran Brief description The library provides subroutines for 1D-6D interpolation using B-splines. The code is written in modern Fortran (i.e., Fortran 2003+). License The bspline-fortran source code and related files and documentation are distributed under a permissive free software license (BSD-style). See also This library includes the public domain DBSPLIN and DTENSBS code from the NIST Core Math Library (CMLIB). Keywords Bspline, spline, interpolation, data fitting, multivariate interpolation, multidimensional interpolation, integration Developer Info Jacob Williams","tags":"home","loc":"index.html"},{"title":"bspline_class – bspline-fortran ","text":"type, public :: bspline_class Base class for the b-spline types Inherited by type~~bspline_class~~InheritedByGraph type~bspline_class bspline_class type~bspline_1d bspline_1d type~bspline_1d->type~bspline_class type~bspline_2d bspline_2d type~bspline_2d->type~bspline_class type~bspline_3d bspline_3d type~bspline_3d->type~bspline_class type~bspline_4d bspline_4d type~bspline_4d->type~bspline_class type~bspline_5d bspline_5d type~bspline_5d->type~bspline_class type~bspline_6d bspline_6d type~bspline_6d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: inbvx = 1_ip internal variable used by dbvalu for efficient processing integer(kind=ip), private :: iflag = 1_ip saved iflag from the list routine call. logical, private :: initialized = .false. true if the class is initialized and ready to use logical, private :: extrap = .false. if true, then extrapolation is allowed during evaluation Type-Bound Procedures procedure, private, non_overridable :: destroy_base destructor for the abstract type private pure subroutine destroy_base (me) Destructor for contents of the base bspline_class class.\n(this routine is called by the extended classes). Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me procedure, private, non_overridable :: set_extrap_flag internal routine to set the extrap flag private pure subroutine set_extrap_flag (me, extrap) Sets the extrap flag in the class. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me logical, intent(in), optional :: extrap if not present, then False is used procedure( destroy_func ), public, deferred :: destroy destructor pure subroutine destroy_func(me) Prototype interface for bspline destructor routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me procedure( size_func ), public, deferred :: size_of size of the structure in bits pure function size_func(me) result(s) Prototype interface for size routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Source Code type , public , abstract :: bspline_class !! Base class for the b-spline types private integer ( ip ) :: inbvx = 1_ip !! internal variable used by [[dbvalu]] for efficient processing integer ( ip ) :: iflag = 1_ip !! saved `iflag` from the list routine call. logical :: initialized = . false . !! true if the class is initialized and ready to use logical :: extrap = . false . !! if true, then extrapolation is allowed during evaluation contains private procedure , non_overridable :: destroy_base !! destructor for the abstract type procedure , non_overridable :: set_extrap_flag !! internal routine to set the `extrap` flag procedure ( destroy_func ), deferred , public :: destroy !! destructor procedure ( size_func ), deferred , public :: size_of !! size of the structure in bits procedure , public , non_overridable :: status_ok !! returns true if the last `iflag` status code was `=0`. procedure , public , non_overridable :: status_message => get_bspline_status_message !! retrieve the last !! status message procedure , public , non_overridable :: clear_flag => clear_bspline_flag !! to reset the `iflag` saved in the class. end type bspline_class","tags":"","loc":"type/bspline_class.html"},{"title":"bspline_1d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_1d Class for 1d b-spline interpolation. Note The 1D class also contains two methods\n for computing definite integrals. Inherits type~~bspline_1d~~InheritsGraph type~bspline_1d bspline_1d type~bspline_class bspline_class type~bspline_1d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db1val] work array of dimension 3*kx Constructor public interface bspline_1d Constructor for bspline_1d private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) Finalization Procedures final :: finalize_1d private pure elemental subroutine finalize_1d (me) Finalizer for bspline_1d class. Just a wrapper for destroy_1d . Arguments Type Intent Optional Attributes Name type( bspline_1d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots private pure subroutine initialize_1d_auto_knots (me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_1d_specify_knots (me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_1d_auto_knots private pure subroutine initialize_1d_auto_knots (me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_1d_specify_knots private pure subroutine initialize_1d_specify_knots (me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_1d private pure subroutine evaluate_1d (me, xval, idx, f, iflag) Evaluate a bspline_1d interpolate. This is a wrapper for db1val . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db1val ) procedure, public :: destroy => destroy_1d private pure subroutine destroy_1d (me) Destructor for bspline_1d class. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure, public :: size_of => size_1d private pure function size_1d (me) result(s) Actual size of a bspline_1d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits procedure, public :: integral => integral_1d private pure subroutine integral_1d (me, x1, x2, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1sqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(out) :: f integral of the b-spline over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) procedure, public :: fintegral => fintegral_1d private subroutine fintegral_1d (me, fun, idx, x1, x2, tol, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1fqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv) integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(in) :: tol desired accuracy for the quadrature real(kind=wp), intent(out) :: f integral of bf(x) over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) Source Code type , extends ( bspline_class ), public :: bspline_1d !! Class for 1d b-spline interpolation. !! !!@note The 1D class also contains two methods !! for computing definite integrals. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x real ( wp ), dimension (:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db1val] work array of dimension `3*kx` contains private generic , public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots procedure :: initialize_1d_auto_knots procedure :: initialize_1d_specify_knots procedure , public :: evaluate => evaluate_1d procedure , public :: destroy => destroy_1d procedure , public :: size_of => size_1d procedure , public :: integral => integral_1d procedure , public :: fintegral => fintegral_1d final :: finalize_1d end type bspline_1d","tags":"","loc":"type/bspline_1d.html"},{"title":"bspline_2d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_2d Class for 2d b-spline interpolation. Inherits type~~bspline_2d~~InheritsGraph type~bspline_2d bspline_2d type~bspline_class bspline_class type~bspline_2d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db2val] work array of dimension ky real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db2val] work array of dimension 3_ip*max(kx,ky) Constructor public interface bspline_2d Constructor for bspline_2d private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) Finalization Procedures final :: finalize_2d private pure elemental subroutine finalize_2d (me) Finalizer for bspline_2d class. Just a wrapper for destroy_2d . Arguments Type Intent Optional Attributes Name type( bspline_2d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots private pure subroutine initialize_2d_auto_knots (me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_2d_specify_knots (me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_2d_auto_knots private pure subroutine initialize_2d_auto_knots (me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_2d_specify_knots private pure subroutine initialize_2d_specify_knots (me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_2d private pure subroutine evaluate_2d (me, xval, yval, idx, idy, f, iflag) Evaluate a bspline_2d interpolate. This is a wrapper for db2val . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db2val ) procedure, public :: destroy => destroy_2d private pure subroutine destroy_2d (me) Destructor for bspline_2d class. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me procedure, public :: size_of => size_2d private pure function size_2d (me) result(s) Actual size of a bspline_2d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_2d !! Class for 2d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y real ( wp ), dimension (:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db2val] work array of dimension `ky` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db2val] work array of dimension `3_ip*max(kx,ky)` contains private generic , public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots procedure :: initialize_2d_auto_knots procedure :: initialize_2d_specify_knots procedure , public :: evaluate => evaluate_2d procedure , public :: destroy => destroy_2d procedure , public :: size_of => size_2d final :: finalize_2d end type bspline_2d","tags":"","loc":"type/bspline_2d.html"},{"title":"bspline_3d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_3d Class for 3d b-spline interpolation. Inherits type~~bspline_3d~~InheritsGraph type~bspline_3d bspline_3d type~bspline_class bspline_class type~bspline_3d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:), allocatable :: work_val_1 [[db3val] work array of dimension ky,kz real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db3val] work array of dimension kz real(kind=wp), private, dimension(:), allocatable :: work_val_3 [[db3val] work array of dimension 3_ip*max(kx,ky,kz) Constructor public interface bspline_3d Constructor for bspline_3d private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) Finalization Procedures final :: finalize_3d private pure elemental subroutine finalize_3d (me) Finalizer for bspline_3d class. Just a wrapper for destroy_3d . Arguments Type Intent Optional Attributes Name type( bspline_3d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots private pure subroutine initialize_3d_auto_knots (me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_3d_specify_knots (me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_3d_auto_knots private pure subroutine initialize_3d_auto_knots (me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_3d_specify_knots private pure subroutine initialize_3d_specify_knots (me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_3d private pure subroutine evaluate_3d (me, xval, yval, zval, idx, idy, idz, f, iflag) Evaluate a bspline_3d interpolate. This is a wrapper for db3val . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db3val ) procedure, public :: destroy => destroy_3d private pure subroutine destroy_3d (me) Destructor for bspline_3d class. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me procedure, public :: size_of => size_3d private pure function size_3d (me) result(s) Actual size of a bspline_3d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_3d !! Class for 3d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z real ( wp ), dimension (:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:), allocatable :: work_val_1 !! [[db3val] work array of dimension `ky,kz` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db3val] work array of dimension `kz` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db3val] work array of dimension `3_ip*max(kx,ky,kz)` contains private generic , public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots procedure :: initialize_3d_auto_knots procedure :: initialize_3d_specify_knots procedure , public :: evaluate => evaluate_3d procedure , public :: destroy => destroy_3d procedure , public :: size_of => size_3d final :: finalize_3d end type bspline_3d","tags":"","loc":"type/bspline_3d.html"},{"title":"bspline_4d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_4d Class for 4d b-spline interpolation. Inherits type~~bspline_4d~~InheritsGraph type~bspline_4d bspline_4d type~bspline_class bspline_class type~bspline_4d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_1 db4val work array of dimension ky,kz,kq real(kind=wp), private, dimension(:,:), allocatable :: work_val_2 db4val work array of dimension kz,kq real(kind=wp), private, dimension(:), allocatable :: work_val_3 db4val work array of dimension kq real(kind=wp), private, dimension(:), allocatable :: work_val_4 db4val work array of dimension 3_ip*max(kx,ky,kz,kq) Constructor public interface bspline_4d Constructor for bspline_4d private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) Finalization Procedures final :: finalize_4d private pure elemental subroutine finalize_4d (me) Finalizer for bspline_4d class. Just a wrapper for destroy_4d . Arguments Type Intent Optional Attributes Name type( bspline_4d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots private pure subroutine initialize_4d_auto_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_4d_specify_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_4d_auto_knots private pure subroutine initialize_4d_auto_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_4d_specify_knots private pure subroutine initialize_4d_specify_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_4d private pure subroutine evaluate_4d (me, xval, yval, zval, qval, idx, idy, idz, idq, f, iflag) Evaluate a bspline_4d interpolate. This is a wrapper for db4val . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db4val ) procedure, public :: destroy => destroy_4d private pure subroutine destroy_4d (me) Destructor for bspline_4d class. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me procedure, public :: size_of => size_4d private pure function size_4d (me) result(s) Actual size of a bspline_4d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_4d !! Class for 4d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q real ( wp ), dimension (:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:), allocatable :: work_val_1 !! [[db4val]] work array of dimension `ky,kz,kq` real ( wp ), dimension (:,:), allocatable :: work_val_2 !! [[db4val]] work array of dimension `kz,kq` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db4val]] work array of dimension `kq` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db4val]] work array of dimension `3_ip*max(kx,ky,kz,kq)` contains private generic , public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots procedure :: initialize_4d_auto_knots procedure :: initialize_4d_specify_knots procedure , public :: evaluate => evaluate_4d procedure , public :: destroy => destroy_4d procedure , public :: size_of => size_4d final :: finalize_4d end type bspline_4d","tags":"","loc":"type/bspline_4d.html"},{"title":"bspline_5d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_5d Class for 5d b-spline interpolation. Inherits type~~bspline_5d~~InheritsGraph type~bspline_5d bspline_5d type~bspline_class bspline_class type~bspline_5d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_1 db5val work array of dimension ky,kz,kq,kr real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_2 db5val work array of dimension kz,kq,kr real(kind=wp), private, dimension(:,:), allocatable :: work_val_3 db5val work array of dimension kq,kr real(kind=wp), private, dimension(:), allocatable :: work_val_4 db5val work array of dimension kr real(kind=wp), private, dimension(:), allocatable :: work_val_5 db5val work array of dimension 3_ip*max(kx,ky,kz,kq,kr) Constructor public interface bspline_5d Constructor for bspline_5d private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) Finalization Procedures final :: finalize_5d private pure elemental subroutine finalize_5d (me) Finalizer for bspline_5d class. Just a wrapper for destroy_5d . Arguments Type Intent Optional Attributes Name type( bspline_5d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots private pure subroutine initialize_5d_auto_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_5d_specify_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_5d_auto_knots private pure subroutine initialize_5d_auto_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_5d_specify_knots private pure subroutine initialize_5d_specify_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_5d private pure subroutine evaluate_5d (me, xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, f, iflag) Evaluate a bspline_5d interpolate. This is a wrapper for db5val . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db5val ) procedure, public :: destroy => destroy_5d private pure subroutine destroy_5d (me) Destructor for bspline_5d class. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me procedure, public :: size_of => size_5d private pure function size_5d (me) result(s) Actual size of a bspline_5d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_5d !! Class for 5d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r real ( wp ), dimension (:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:), allocatable :: work_val_1 !! [[db5val]] work array of dimension `ky,kz,kq,kr` real ( wp ), dimension (:,:,:), allocatable :: work_val_2 !! [[db5val]] work array of dimension `kz,kq,kr` real ( wp ), dimension (:,:), allocatable :: work_val_3 !! [[db5val]] work array of dimension `kq,kr` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db5val]] work array of dimension `kr` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db5val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr)` contains private generic , public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots procedure :: initialize_5d_auto_knots procedure :: initialize_5d_specify_knots procedure , public :: evaluate => evaluate_5d procedure , public :: destroy => destroy_5d procedure , public :: size_of => size_5d final :: finalize_5d end type bspline_5d","tags":"","loc":"type/bspline_5d.html"},{"title":"bspline_6d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_6d Class for 6d b-spline interpolation. Inherits type~~bspline_6d~~InheritsGraph type~bspline_6d bspline_6d type~bspline_class bspline_class type~bspline_6d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: ns = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in integer(kind=ip), private :: ks = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ts The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvs = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilos = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: work_val_1 db6val work array of dimension ky,kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_2 db6val work array of dimension kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_3 db6val work array of dimension kq,kr,ks real(kind=wp), private, dimension(:,:), allocatable :: work_val_4 db6val work array of dimension kr,ks real(kind=wp), private, dimension(:), allocatable :: work_val_5 db6val work array of dimension ks real(kind=wp), private, dimension(:), allocatable :: work_val_6 db6val work array of dimension 3_ip*max(kx,ky,kz,kq,kr,ks) Constructor public interface bspline_6d Constructor for bspline_6d private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Finalization Procedures final :: finalize_6d private pure elemental subroutine finalize_6d (me) Finalizer for bspline_6d class. Just a wrapper for destroy_6d . Arguments Type Intent Optional Attributes Name type( bspline_6d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots private pure subroutine initialize_6d_auto_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_6d_specify_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_6d_auto_knots private pure subroutine initialize_6d_auto_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_6d_specify_knots private pure subroutine initialize_6d_specify_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_6d private pure subroutine evaluate_6d (me, xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, f, iflag) Evaluate a bspline_6d interpolate. This is a wrapper for db6val . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db6val ) procedure, public :: destroy => destroy_6d private pure subroutine destroy_6d (me) Destructor for bspline_6d class. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me procedure, public :: size_of => size_6d private pure function size_6d (me) result(s) Actual size of a bspline_6d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_6d !! Class for 6d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: ns = 0_ip !! Number of s abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r integer ( ip ) :: ks = 0_ip !! The order of spline pieces in s real ( wp ), dimension (:,:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ts !! The knots in the s direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvs = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilos = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:,:), allocatable :: work_val_1 !! [[db6val]] work array of dimension `ky,kz,kq,kr,ks` real ( wp ), dimension (:,:,:,:), allocatable :: work_val_2 !! [[db6val]] work array of dimension `kz,kq,kr,ks` real ( wp ), dimension (:,:,:), allocatable :: work_val_3 !! [[db6val]] work array of dimension `kq,kr,ks` real ( wp ), dimension (:,:), allocatable :: work_val_4 !! [[db6val]] work array of dimension `kr,ks` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db6val]] work array of dimension `ks` real ( wp ), dimension (:), allocatable :: work_val_6 !! [[db6val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr,ks)` contains private generic , public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots procedure :: initialize_6d_auto_knots procedure :: initialize_6d_specify_knots procedure , public :: evaluate => evaluate_6d procedure , public :: destroy => destroy_6d procedure , public :: size_of => size_6d final :: finalize_6d end type bspline_6d","tags":"","loc":"type/bspline_6d.html"},{"title":"b1fqad_func – bspline-fortran","text":"interface public function b1fqad_func(x) result(f) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x Return Value real(kind=wp) f(x) Description interface for the input function in dbfqad","tags":"","loc":"interface/b1fqad_func.html"},{"title":"size_func – bspline-fortran","text":"interface private pure function size_func(me) result(s) Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Description interface for size routines","tags":"","loc":"interface/size_func.html"},{"title":"destroy_func – bspline-fortran","text":"interface private pure subroutine destroy_func(me) Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Description interface for bspline destructor routines","tags":"","loc":"interface/destroy_func.html"},{"title":"dwnlt2 – bspline-fortran","text":"private function dwnlt2(me, mend, ir, factor, tau, scale, wic) To test independence of incoming column. Test the column IC to determine if it is linearly independent\n of the columns already in the basis. In the initial tri. step,\n we usually want the heavy weight ALAMDA to be included in the\n test for independence. In this case, the value of FACTOR will\n have been set to 1.0 before this procedure is invoked.\n In the potentially rank deficient problem, the value of FACTOR\n will have been set to ALSQ=ALAMDA**2 to remove the effect of the\n heavy weight from the test for independence. Write new column as partitioned vector (A1) number of components in solution so far = NIV (A2) M-NIV components And compute SN = inverse weighted length of A1 RN = inverse weighted length of A2 Call the column independent when RN > TAU*SN Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890620 Code extracted from WNLIT and made a subroutine. (RWC)) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer :: me integer :: mend integer :: ir real(kind=wp) :: factor real(kind=wp) :: tau real(kind=wp) :: scale (*) real(kind=wp) :: wic (*) Return Value logical Called by proc~~dwnlt2~~CalledByGraph proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dwnlt2 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code logical function dwnlt2 ( me , mend , ir , factor , tau , scale , wic ) real ( wp ) :: factor , scale ( * ), tau , wic ( * ) integer :: ir , me , mend real ( wp ) :: rn , sn , t integer :: j sn = 0.0_wp rn = 0.0_wp do j = 1 , mend t = scale ( j ) if ( j <= me ) t = t / factor t = t * wic ( j ) ** 2 if ( j < ir ) then sn = sn + t else rn = rn + t endif end do dwnlt2 = rn > sn * tau ** 2 end function dwnlt2","tags":"","loc":"proc/dwnlt2.html"},{"title":"dcv – bspline-fortran","text":"public function dcv(xval, ndata, nconst, nord, nbkpt, bkpt, w) dcv is a companion function subprogram for dfc . The\n documentation for dfc has complete usage instructions. dcv is used to evaluate the variance function of the curve\n obtained by the constrained B-spline fitting subprogram, dfc .\n The variance function defines the square of the probable error\n of the fitted curve at any point, XVAL. One can use the square\n root of this variance function to determine a probable error band\n around the fitted curve. dcv is used after a call to dfc . MODE, an input variable to dfc , is used to indicate if the variance function is desired.\n In order to use dcv , MODE must equal 2 or 4 on input to dfc .\n MODE is also used as an output flag from dfc . Check to make\n sure that MODE = 0 after calling dfc , indicating a successful\n constrained curve fit. The array SDDATA, as input to dfc , must\n also be defined with the standard deviation or uncertainty of the\n Y values to use dcv . To evaluate the variance function after calling dfc as stated\n above, use dcv as shown here VAR = DCV(XVAL,NDATA,NCONST,NORD,NBKPT,BKPT,W) The variance function is given by VAR = (transpose of B(XVAL))*C*B(XVAL)/DBLE(MAX(NDATA-N,1)) where N = NBKPT - NORD . The vector B(XVAL) is the B-spline basis function values at\n X=XVAL. The covariance matrix, C, of the solution coefficients\n accounts only for the least squares equations and the explicitly\n stated equality constraints. This fact must be considered when\n interpreting the variance function from a data fitting problem\n that has inequality constraints on the fitted curve. All the variables in the calling sequence for dcv are used in dfc except the variable XVAL. Do not change the values of\n these variables between the call to dfc and the use of dcv . Reference R. J. Hanson, Constrained least squares curve fitting\n to discrete data using B-splines, a users guide,\n Report SAND78-1291, Sandia Laboratories, December\n 1978. Revision history 780801 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890831 Modified array declarations. (WRB) 890911 Removed unnecessary intrinsics. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval The point where the variance is desired integer, intent(in) :: ndata The number of discrete (X,Y) pairs for which dfc calculated a piece-wise polynomial curve. integer, intent(in) :: nconst The number of conditions that constrained the B-spline in dfc . integer, intent(in) :: nord The order of the B-spline used in dfc .\nThe value of NORD must satisfy 1 < NORD < 20 . (The order of the spline is one more than the degree of\nthe piece-wise polynomial defined on each interval. This\nis consistent with the B-spline package convention. For\nexample, NORD=4 when we are using piece-wise cubics.) integer, intent(in) :: nbkpt The number of knots in the array BKPT( ).\nThe value of NBKPT must satisfy NBKPT .GE. 2 NORD. real(kind=wp), intent(in) :: bkpt (*) The array of knots. Normally the problem\ndata interval will be included between the limits\nBKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end\nknots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT,\nare required by dfc to compute the functions used to\nfit the data. real(kind=wp) :: w (*) Real work array as used in dfc . See dfc for the required length of W( ). The contents of W( )\nmust not be modified by the user if the variance function\nis desired. Return Value real(kind=wp) Calls proc~~dcv~~CallsGraph proc~dcv bspline_defc_module::dcv proc~ddot bspline_blas_module::ddot proc~dcv->proc~ddot proc~dfspvn bspline_defc_module::dfspvn proc~dcv->proc~dfspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code real ( wp ) function dcv ( xval , ndata , nconst , nord , nbkpt , bkpt , w ) real ( wp ), intent ( in ) :: xval !! The point where the variance is desired integer , intent ( in ) :: nbkpt !! The number of knots in the array BKPT(*). !! The value of NBKPT must satisfy NBKPT .GE. 2*NORD. integer , intent ( in ) :: nconst !! The number of conditions that constrained the B-spline in !! [[dfc]]. integer , intent ( in ) :: ndata !! The number of discrete (X,Y) pairs for which [[dfc]] !! calculated a piece-wise polynomial curve. integer , intent ( in ) :: nord !! The order of the B-spline used in [[dfc]]. !! The value of NORD must satisfy 1 < NORD < 20 . !! !! (The order of the spline is one more than the degree of !! the piece-wise polynomial defined on each interval. This !! is consistent with the B-spline package convention. For !! example, NORD=4 when we are using piece-wise cubics.) real ( wp ), intent ( in ) :: bkpt ( * ) !! The array of knots. Normally the problem !! data interval will be included between the limits !! BKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end !! knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT, !! are required by [[dfc]] to compute the functions used to !! fit the data. real ( wp ) :: w ( * ) !! Real work array as used in [[dfc]]. See [[dfc]] !! for the required length of W(*). The contents of W(*) !! must not be modified by the user if the variance function !! is desired. real ( wp ) :: v ( 40 ) integer :: i , ileft , ip , is , last , mdg , mdw , n integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap real ( wp ), parameter :: zero = 0.0_wp ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = zero dfspvn_deltap = zero mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst is = mdg * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + nord ** 2 last = nbkpt - nord + 1 ileft = nord do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= last - 1 ) exit ileft = ileft + 1 end do call dfspvn ( bkpt , nord , 1 , xval , ileft , v ( nord + 1 ), & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ileft = ileft - nord + 1 ip = mdw * ( ileft - 1 ) + ileft + is n = nbkpt - nord do i = 1 , nord v ( i ) = ddot ( nord , w ( ip ), 1 , v ( nord + 1 ), 1 ) ip = ip + mdw end do dcv = max ( ddot ( nord , v , 1 , v ( nord + 1 ), 1 ), zero ) ! scale the variance so it is an unbiased estimate. dcv = dcv / max ( ndata - n , 1 ) end function dcv","tags":"","loc":"proc/dcv.html"},{"title":"defc – bspline-fortran","text":"public subroutine defc(Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkpt, Mdein, Mdeout, Coeff, Lw, w) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense. The data can be processed in groups of modest size.\n The size of the group is chosen by the user. This feature\n may be necessary for purposes of using constrained curve fitting\n with subprogram DFC on a very large data set. Evaluating the Fitted Curve To evaluate derivative number IDER at XVAL ,\n use the function subprogram DBVALU . f = dbvalu ( bkpt , coeff , nbkpt - nord , nord , ider , xval , inbv , workb ) The output of this subprogram will not be\n defined unless an output value of MDEOUT=1 was obtained from DEFC , XVAL is in the data\n interval, and IDER is nonnegative and < NORD . The first time DBVALU is called, INBV=1 must be specified. This value of INBV is the\n overwritten by DBVALU . The array WORKB(*) must be of length at least 3*NORD , and must\n not be the same as the W(*) array used in the\n call to DEFC . DBVALU expects the breakpoint array BKPT(*) to be sorted. Revision history 800801 DATE WRITTEN.\n WRITTEN BY R. HANSON, SANDIA NATL. LABS.,\n ALB., N. M., AUGUST-SEPTEMBER, 1980. 890531 Changed all specific intrinsics to generic. (WRB) 890531 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900510 Change Prologue comments to refer to XERMSG. (RWC) 900607 Editorial changes to Prologue to make Prologues for EFC,\n DEFC, FC, and DFC look as much the same as possible. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Jacob Williams, 2022 : modernized Arguments Type Intent Optional Attributes Name integer, intent(in) :: Ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in), dimension(ndata) :: Xdata X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in), dimension(ndata) :: Ydata Y data array. real(kind=wp), intent(in), dimension(ndata) :: Sddata Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: Nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(:) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: Mdein An integer flag, with one of two possible\nvalues (1 or 2), that directs the subprogram\naction with regard to new data points provided\nby the user: = 1 The first time that DEFC has been\n entered. There are NDATA points to process. = 2 This is another entry to DEFC(). The\n subprogram DEFC has been entered with MDEIN=1\n exactly once before for this problem. There\n are NDATA new additional points to merge and\n process with any previous points.\n (When using DEFC with MDEIN=2 it is\n important that the set of knots remain fixed at the\n same values for all entries to DEFC .) integer, intent(out) :: Mdeout An output flag that indicates the status\nof the curve fit: =-1 A usage error of DEFC occurred. The\n offending condition is noted with the SLATEC\n library error processor, XERMSG( ) . In case\n the working array W(*) is not long enough, the\n minimal acceptable length is printed. =1 The B-spline coefficients for the fitted\n curve have been returned in array COEFF(*) . =2 Not enough data has been processed to\n determine the B-spline coefficients.\n The user has one of two options. Continue\n to process more data until a unique set\n of coefficients is obtained, or use the\n subprogram DFC to obtain a specific\n set of coefficients. The user should read\n the usage instructions for DFC for further\n details if this second option is chosen. real(kind=wp), intent(out) :: Coeff (*) If the output value of MDEOUT=1 , this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD parameters are the B-spline coefficients.\nFor MDEOUT=2 , not enough data was processed to\nuniquely determine the B-spline coefficients.\nIn this case, and also when MDEOUT=-1 , all\nvalues of COEFF(*) are set to zero. If the user is not satisfied with the fitted\ncurve returned by DEFC , the constrained\nleast squares curve fitting subprogram DFC may be required. The work done within DEFC to accumulate the data can be utilized by\nthe user, if so desired. This involves\nsaving the first (NBKPT-NORD+3)*(NORD+1) entries of W(*) and providing this data\nto DFC with the \"old problem\" designation.\nThe user should read the usage instructions\nfor subprogram DFC for further details. integer, intent(in) :: Lw The amount of working storage actually\n allocated for the working array W(*) .\n This quantity is compared with the\n actual amount of storage needed in DEFC .\n Insufficient storage allocated for W(*) is\n an error. This feature was included in DEFC because misreading the storage formula\n for W(*) might very well lead to subtle\n and hard-to-find programming bugs. The length of the array W(*) must satisfy LW >= (NBKPT-NORD+3)*(NORD+1)+\n (NBKPT+1)*(NORD+1)+\n 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 real(kind=wp) :: w (*) Working Array.\nIts length is specified as an input parameter\nin LW as noted above. The contents of W(*) must not be modified by the user between calls\nto DEFC with values of MDEIN=1,2,2,... .\nThe first (NBKPT-NORD+3)*(NORD+1) entries of W(*) are acceptable as direct input to DFC for an \"old problem\" only when MDEOUT=1 or 2 . Calls proc~~defc~~CallsGraph proc~defc bspline_defc_module::defc proc~defcmn bspline_defc_module::defcmn proc~defc->proc~defcmn proc~dbndac bspline_defc_module::dbndac proc~defcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~defcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~defcmn->proc~dcopy proc~dfspvn bspline_defc_module::dfspvn proc~defcmn->proc~dfspvn proc~dscal bspline_blas_module::dscal proc~defcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~defcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine defc ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , & Mdeout , Coeff , Lw , w ) integer , intent ( in ) :: Ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), dimension ( ndata ), intent ( in ) :: Xdata !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), dimension ( ndata ), intent ( in ) :: Ydata !! Y data array. real ( wp ), dimension ( ndata ), intent ( in ) :: Sddata !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: Nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension (:), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: Mdein !! An integer flag, with one of two possible !! values (1 or 2), that directs the subprogram !! action with regard to new data points provided !! by the user: !! !! * `= 1` The first time that [[DEFC]] has been !! entered. There are NDATA points to process. !! * `= 2` This is another entry to DEFC(). The !! subprogram [[DEFC]] has been entered with MDEIN=1 !! exactly once before for this problem. There !! are NDATA new additional points to merge and !! process with any previous points. !! (When using [[DEFC]] with MDEIN=2 it is !! important that the set of knots remain fixed at the !! same values for all entries to [[DEFC]].) integer , intent ( out ) :: Mdeout !! An output flag that indicates the status !! of the curve fit: !! !! * `=-1` A usage error of [[DEFC]] occurred. The !! offending condition is noted with the SLATEC !! library error processor, `XERMSG( )`. In case !! the working array `W(*)` is not long enough, the !! minimal acceptable length is printed. !! !! * `=1` The B-spline coefficients for the fitted !! curve have been returned in array `COEFF(*)`. !! !! * `=2` Not enough data has been processed to !! determine the B-spline coefficients. !! The user has one of two options. Continue !! to process more data until a unique set !! of coefficients is obtained, or use the !! subprogram [[DFC]] to obtain a specific !! set of coefficients. The user should read !! the usage instructions for [[DFC]] for further !! details if this second option is chosen. real ( wp ), intent ( out ) :: Coeff ( * ) !! If the output value of `MDEOUT=1`, this array !! contains the unknowns obtained from the least !! squares fitting process. These `N=NBKPT-NORD` !! parameters are the B-spline coefficients. !! For `MDEOUT=2`, not enough data was processed to !! uniquely determine the B-spline coefficients. !! In this case, and also when `MDEOUT=-1`, all !! values of `COEFF(*)` are set to zero. !! !! If the user is not satisfied with the fitted !! curve returned by [[DEFC]], the constrained !! least squares curve fitting subprogram [[DFC]] !! may be required. The work done within [[DEFC]] !! to accumulate the data can be utilized by !! the user, if so desired. This involves !! saving the first `(NBKPT-NORD+3)*(NORD+1)` !! entries of `W(*)` and providing this data !! to [[DFC]] with the \"old problem\" designation. !! The user should read the usage instructions !! for subprogram [[DFC]] for further details. integer , intent ( in ) :: Lw !! The amount of working storage actually !! allocated for the working array `W(*)`. !! This quantity is compared with the !! actual amount of storage needed in [[DEFC]]. !! Insufficient storage allocated for `W(*)` is !! an error. This feature was included in [[DEFC]] !! because misreading the storage formula !! for `W(*)` might very well lead to subtle !! and hard-to-find programming bugs. !! !! The length of the array `W(*)` must satisfy !!``` !! LW >= (NBKPT-NORD+3)*(NORD+1)+ !! (NBKPT+1)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` real ( wp ) :: w ( * ) !! Working Array. !! Its length is specified as an input parameter !! in `LW` as noted above. The contents of `W(*)` !! must not be modified by the user between calls !! to [[DEFC]] with values of `MDEIN=1,2,2,...` . !! The first `(NBKPT-NORD+3)*(NORD+1)` entries of !! `W(*)` are acceptable as direct input to [[DFC]] !! for an \"old problem\" only when `MDEOUT=1` or `2`. integer :: lbf , lbkpt , lg , lptemp , lww , lxtemp , mdg , mdw ! LWW=1 USAGE IN DEFCMN( ) OF W(*).. ! LWW,...,LG-1 W(*,*) ! LG,...,LXTEMP-1 G(*,*) ! LXTEMP,...,LPTEMP-1 XTEMP(*) ! LPTEMP,...,LBKPT-1 PTEMP(*) ! LBKPT,...,LBF BKPT(*) (LOCAL TO DEFCMN( )) ! LBF,...,LBF+NORD**2 BF(*,*) mdg = Nbkpt + 1 mdw = Nbkpt - Nord + 3 lww = 1 lg = lww + mdw * ( Nord + 1 ) lxtemp = lg + mdg * ( Nord + 1 ) lptemp = lxtemp + max ( Ndata , Nbkpt ) lbkpt = lptemp + max ( Ndata , Nbkpt ) lbf = lbkpt + Nbkpt call defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , Mdeout , & Coeff , w ( lbf ), w ( lxtemp ), w ( lptemp ), w ( lbkpt ), w ( lg ), mdg , & w ( lww ), mdw , Lw ) end subroutine defc","tags":"","loc":"proc/defc.html"},{"title":"defcmn – bspline-fortran","text":"private subroutine defcmn(Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkptin, Mdein, Mdeout, Coeff, Bf, Xtemp, Ptemp, Bkpt, g, Mdg, w, Mdw, Lw) This is a companion subprogram to DEFC .\n This subprogram does weighted least squares fitting of data by\n B-spline curves.\n The documentation for DEFC has complete usage instructions. Revision history 800801 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900328 Added TYPE section. (WRB) 900510 Convert XERRWV calls to XERMSG calls. (RWC) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer :: Ndata real(kind=wp) :: Xdata (*) real(kind=wp) :: Ydata (*) real(kind=wp) :: Sddata (*) integer :: Nord integer :: Nbkpt real(kind=wp) :: Bkptin (*) integer :: Mdein integer :: Mdeout real(kind=wp) :: Coeff (*) real(kind=wp) :: Bf (Nord,*) real(kind=wp) :: Xtemp (*) real(kind=wp) :: Ptemp (*) real(kind=wp) :: Bkpt (*) real(kind=wp) :: g (Mdg,*) integer :: Mdg real(kind=wp) :: w (Mdw,*) integer :: Mdw integer :: Lw Calls proc~~defcmn~~CallsGraph proc~defcmn bspline_defc_module::defcmn proc~dbndac bspline_defc_module::dbndac proc~defcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~defcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~defcmn->proc~dcopy proc~dfspvn bspline_defc_module::dfspvn proc~defcmn->proc~dfspvn proc~dscal bspline_blas_module::dscal proc~defcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~defcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~defcmn~~CalledByGraph proc~defcmn bspline_defc_module::defcmn proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkptin , & Mdein , Mdeout , Coeff , Bf , Xtemp , Ptemp , Bkpt , g , Mdg , w , & Mdw , Lw ) integer :: Lw , Mdein , Mdeout , Mdg , Mdw , Nbkpt , Ndata , Nord real ( wp ) :: Bf ( Nord , * ), Bkpt ( * ), Bkptin ( * ), Coeff ( * ), & g ( Mdg , * ), Ptemp ( * ), Sddata ( * ), w ( Mdw , * ), & Xdata ( * ), Xtemp ( * ), Ydata ( * ) real ( wp ) :: rnorm , xmax , xmin , xval integer :: i , idata , ileft , intseq , ip , ir , irow , l , mt , n , & nb , nordm1 , nordp1 , np1 character ( len = 8 ) :: xern1 , xern2 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Initialize variables and analyze input. n = Nbkpt - Nord np1 = n + 1 ! Initially set all output coefficients to zero. call dcopy ( n , [ 0.0_wp ], 0 , Coeff , 1 ) Mdeout = - 1 if ( Nord < 1 . or . Nord > 20 ) then write ( * , * ) 'IN DEFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' return end if if ( Nbkpt < 2 * Nord ) then write ( * , * ) 'IN DEFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE THE B-SPLINE ORDER.' return end if if ( Ndata < 0 ) then write ( * , * ) 'IN DEFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' return end if nb = ( Nbkpt - Nord + 3 ) * ( Nord + 1 ) + ( Nbkpt + 1 ) * ( Nord + 1 ) & + 2 * max ( Nbkpt , Ndata ) + Nbkpt + Nord ** 2 if ( Lw < nb ) then write ( xern1 , '(I8)' ) nb write ( xern2 , '(I8)' ) Lw write ( * , * ) 'IN DEFC, INSUFFICIENT STORAGE FOR W(*). CHECK FORMULA ' // & 'THAT READS LW>= ... . NEED = ' // xern1 // & ' GIVEN = ' // xern2 Mdeout = - 1 return end if if ( Mdein /= 1 . and . Mdein /= 2 ) then write ( * , * ) 'IN DEFC, INPUT VALUE OF MDEIN MUST BE 1-2.' return end if ! Sort the breakpoints. call dcopy ( Nbkpt , Bkptin , 1 , Bkpt , 1 ) call dsort ( Nbkpt , 1 , Bkpt ) ! Save interval containing knots. xmin = Bkpt ( Nord ) xmax = Bkpt ( np1 ) nordm1 = Nord - 1 nordp1 = Nord + 1 ! Process least squares equations. ! Sort data and an array of pointers. call dcopy ( Ndata , Xdata , 1 , Xtemp , 1 ) do i = 1 , Ndata Ptemp ( i ) = i end do ! JW : really Ptemp should be an integer array. ! it is real because they are stuffing it in ! a real work array and also using dsort on it. if ( Ndata > 0 ) then call dsort ( Ndata , 2 , Xtemp , Ptemp ) xmin = min ( xmin , Xtemp ( 1 )) xmax = max ( xmax , Xtemp ( Ndata )) end if ! Fix breakpoint array if needed. This should only involve very ! minor differences with the input array of breakpoints. do i = 1 , Nord Bkpt ( i ) = min ( Bkpt ( i ), xmin ) end do do i = np1 , Nbkpt Bkpt ( i ) = max ( Bkpt ( i ), xmax ) end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = Nord intseq = 1 do idata = 1 , Ndata ! Sorted indices are in PTEMP(*). l = int ( Ptemp ( idata )) xval = Xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= Bkpt ( ileft + 1 )) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ILEFT<=N. do ileft = ileft , n if ( xval < Bkpt ( ileft + 1 )) exit if ( Mdein == 2 ) then ! Data is being sequentially accumulated. ! Transfer previously accumulated rows from W(*,*) to ! G(*,*) and process them. call dcopy ( nordp1 , w ( intseq , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , intseq ) intseq = intseq + 1 end if end do end if ! Obtain B-spline function value. call dfspvn ( Bkpt , Nord , 1 , xval , ileft , Bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( Nord , Bf , 1 , g ( irow , 1 ), Mdg ) g ( irow , nordp1 ) = Ydata ( l ) ! Scale data if uncertainty is nonzero. if ( Sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / Sddata ( l ), g ( irow , 1 ), Mdg ) ! When staging work area is exhausted, process rows. if ( irow == Mdg - 1 ) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 end if end do ! Process last block of equations. call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) ! Finish processing any previously accumulated rows from W(*,*) ! to G(*,*). if ( Mdein == 2 ) then do i = intseq , np1 call dcopy ( nordp1 , w ( i , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , min ( n , i )) end do end if ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , np1 ) ! Transfer accumulated rows from G(*,*) to W(*,*) for ! possible later sequential accumulation. do i = 1 , np1 call dcopy ( nordp1 , g ( i , 1 ), Mdg , w ( i , 1 ), Mdw ) end do ! Solve for coefficients when possible. do i = 1 , n if ( g ( i , 1 ) == 0.0_wp ) then Mdeout = 2 return end if end do ! All the diagonal terms in the accumulated triangular ! matrix are nonzero. The solution can be computed but ! it may be unsuitable for further use due to poor ! conditioning or the lack of constraints. No checking ! for either of these is done here. call dbndsl ( 1 , g , Mdg , Nord , ip , ir , Coeff , n , rnorm ) Mdeout = 1 end subroutine defcmn","tags":"","loc":"proc/defcmn.html"},{"title":"dbndac – bspline-fortran","text":"private subroutine dbndac(g, Mdg, Nb, Ip, Ir, Mt, Jt) These subroutines solve the least squares problem Ax = b for\n banded matrices A using sequential accumulation of rows of the\n data matrix. Exactly one right-hand side vector is permitted. These subroutines are intended for the type of least squares\n systems that arise in applications such as curve or surface\n fitting of data. The least squares equations are accumulated and\n processed using only part of the data. This requires a certain\n user interaction during the solution of Ax = b. Specifically, suppose the data matrix (A B) is row partitioned\n into Q submatrices. Let (E F) be the T-th one of these\n submatrices where E = (0 C 0). Here the dimension of E is MT by N\n and the dimension of C is MT by NB. The value of NB is the\n bandwidth of A. The dimensions of the leading block of zeros in E\n are MT by JT-1. The user of the subroutine DBNDAC provides MT,JT,C and F for\n T=1,...,Q. Not all of this data must be supplied at once. Following the processing of the various blocks (E F), the matrix\n (A B) has been transformed to the form (R D) where R is upper\n triangular and banded with bandwidth NB. The least squares\n system Rx = d is then easily solved using back substitution by\n executing the statement CALL DBNDSL(1,...). The sequence of\n values for JT must be nondecreasing. This may require some\n preliminary interchanges of rows and columns of the matrix A. The primary reason for these subroutines is that the total\n processing can take place in a working array of dimension MU by\n NB+1. An acceptable value for MU is MU = MAX(MT + N + 1), where N is the number of unknowns. Here the maximum is taken over all values of MT for T=1,...,Q.\n Notice that MT can be taken to be a small as one, showing that\n MU can be as small as N+2. The subprogram DBNDAC processes the\n rows more efficiently if MU is large enough so that each new\n block (C F) has a distinct value of JT. The four principle parts of these algorithms are obtained by the\n following call statements: CALL [[DBNDAC]](...) Introduce new blocks of data. CALL [[DBNDSL]](1,...) Compute solution vector and length of\n residual vector. CALL [[DBNDSL]](2,...) Given any row vector H solve YR = H for the\n row vector Y. CALL [[DBNDSL]](3,...) Given any column vector W solve RZ = W for\n the column vector Z. Remarks To obtain the upper triangular matrix and transformed right-hand\n side vector D so that the super diagonals of R form the columns\n of G( , ), execute the following Fortran statements. nbp1 = nb + 1 do j = 1 , nbp1 g ( ir , j ) = 0.0 end do mt = 1 jt = n + 1 call dbndac ( g , mdg , nb , ip , ir , mt , jt ) References C. L. Lawson and R. J. Hanson, Solving Least Squares\n Problems, Prentice-Hall, Inc., 1974, Chapter 27. Revision history 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: g (Mdg,*) G(MDG,NB+1) Input The working array into which the user will\nplace the MT by NB+1 block (C F) in rows IR through IR+MT-1 , columns 1 through NB+1 .\nSee descriptions of IR and MT below. Output The working array which will contain the\nprocessed rows of that part of the data\nmatrix which has been passed to DBNDAC . integer, intent(in) :: Mdg The number of rows in the working array G(*,*) . The value of MDG should be >= MU .\nThe value of MU is defined in the abstract\nof these subprograms. integer, intent(in) :: Nb The bandwidth of the data matrix A . integer, intent(inout) :: Ip Input Set by the user to the value 1 before the\nfirst call to DBNDAC . Its subsequent value\nis controlled by DBNDAC to set up for the\nnext call to DBNDAC . Output The value of this argument is advanced by DBNDAC to be ready for storing and processing\na new block of data in G(*,*) . integer, intent(inout) :: Ir Input Index of the row of G(*,*) where the user is\nto place the new block of data (C F) . Set by\nthe user to the value 1 before the first call\nto DBNDAC . Its subsequent value is controlled\nby DBNDAC . A value of IR > MDG is considered\nan error. Output The value of this argument is advanced by DBNDAC to be ready for storing and processing\na new block of data in G(*,*) . integer, intent(in) :: Mt Set by the user to indicate the\nnumber of new rows of data in the block integer, intent(in) :: Jt Set by the user to indicate\nthe index of the first nonzero column in that\nset of rows (E F) = (0 C 0 F) being processed. Calls proc~~dbndac~~CallsGraph proc~dbndac bspline_defc_module::dbndac proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbndac~~CalledByGraph proc~dbndac bspline_defc_module::dbndac proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dbndac proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbndac ( g , Mdg , Nb , Ip , Ir , Mt , Jt ) implicit none integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of MDG should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. real ( wp ), intent ( inout ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! *Input* !! The working array into which the user will !! place the `MT` by `NB+1` block `(C F)` in rows `IR` !! through `IR+MT-1`, columns 1 through `NB+1`. !! See descriptions of `IR` and `MT` below. !! !! *Output* !! The working array which will contain the !! processed rows of that part of the data !! matrix which has been passed to [[DBNDAC]]. integer , intent ( in ) :: Nb !! The bandwidth of the data matrix `A`. integer , intent ( inout ) :: Ip !! *Input* !! Set by the user to the value 1 before the !! first call to [[DBNDAC]]. Its subsequent value !! is controlled by [[DBNDAC]] to set up for the !! next call to [[DBNDAC]]. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( inout ) :: Ir !! *Input* !! Index of the row of `G(*,*)` where the user is !! to place the new block of data `(C F)`. Set by !! the user to the value 1 before the first call !! to [[DBNDAC]]. Its subsequent value is controlled !! by [[DBNDAC]]. A value of `IR > MDG` is considered !! an error. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( in ) :: Mt !! Set by the user to indicate the !! number of new rows of data in the block integer , intent ( in ) :: Jt !! Set by the user to indicate !! the index of the first nonzero column in that !! set of rows `(E F) = (0 C 0 F)` being processed. real ( wp ) :: rho integer :: i , ie , ig , ig1 , ig2 , iopt , j , jg , & k , kh , l , lp1 , mh , mu , nbp1 , nerr real ( wp ), parameter :: zero = 0.0_wp ! ALG. STEPS 1-4 ARE PERFORMED EXTERNAL TO THIS SUBROUTINE. nbp1 = Nb + 1 if ( Mt <= 0 . or . Nb <= 0 ) return if (. not . Mdg < Ir ) then if ( Jt /= Ip ) then if ( Jt > Ir ) then do i = 1 , Mt ig1 = Jt + Mt - i ig2 = Ir + Mt - i do j = 1 , nbp1 g ( ig1 , j ) = g ( ig2 , j ) end do end do ie = Jt - Ir do i = 1 , ie ig = Ir + i - 1 do j = 1 , nbp1 g ( ig , j ) = zero end do end do Ir = Jt end if mu = min ( Nb - 1 , Ir - Ip - 1 ) if ( mu /= 0 ) then do l = 1 , mu k = min ( l , Jt - Ip ) lp1 = l + 1 ig = Ip + l do i = lp1 , Nb jg = i - k g ( ig , jg ) = g ( ig , i ) end do do i = 1 , k jg = nbp1 - i g ( ig , jg ) = zero end do end do end if Ip = Jt end if mh = Ir + Mt - Ip kh = min ( nbp1 , mh ) do i = 1 , kh call dh12 ( 1 , i , max ( i + 1 , Ir - Ip + 1 ), mh , g ( Ip , i ), 1 , & rho , g ( Ip , i + 1 ), 1 , Mdg , nbp1 - i ) end do Ir = Ip + kh if ( kh >= nbp1 ) then do i = 1 , Nb g ( Ir - 1 , i ) = zero end do end if else nerr = 1 iopt = 2 write ( * , * ) 'MDG= MU .\nThe value of MU is defined in the abstract\nof these subprograms. This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Nb This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ip This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ir This argument has the same meaning and\ncontents as following the last call to DBNDAC . real(kind=wp), intent(inout) :: x (*) X(N) Input With mode=2 or 3 this array contains,\nrespectively, the right-side vectors H or W of\nthe systems YR = H or RZ = W. Output This array contains the solution vectors X , Y or Z of the systems AX = B , YR = H or RZ = W depending on the value of MODE =1,\n2 or 3. integer, intent(in) :: n The number of variables in the solution\nvector. If any of the N diagonal terms are\nzero the subroutine DBNDSL prints an\nappropriate message. This condition is\nconsidered an error. real(kind=wp), intent(out) :: Rnorm If MODE=1 , RNORM is the Euclidean length of the\nresidual vector AX-B . When MODE=2 or 3 RNORM`\nis set to zero. Called by proc~~dbndsl~~CalledByGraph proc~dbndsl bspline_defc_module::dbndsl proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndsl proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dbndsl proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbndsl ( Mode , g , Mdg , Nb , Ip , Ir , x , n , Rnorm ) integer , intent ( in ) :: Mode !! Set by the user to one of the values 1, 2, or !! 3. These values respectively indicate that !! the solution of `AX = B`, `YR = H` or `RZ = W` is !! required. integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of `MDG` should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( in ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Nb !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ip !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ir !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( inout ) :: x ( * ) !! `X(N)` !! !! *Input* With mode=2 or 3 this array contains, !! respectively, the right-side vectors H or W of !! the systems YR = H or RZ = W. !! !! *Output* This array contains the solution vectors `X`, !! `Y` or `Z` of the systems `AX = B`, `YR = H` or !! `RZ = W` depending on the value of `MODE`=1, !! 2 or 3. integer , intent ( in ) :: n !! The number of variables in the solution !! vector. If any of the `N` diagonal terms are !! zero the subroutine [[DBNDSL]] prints an !! appropriate message. This condition is !! considered an error. real ( wp ), intent ( out ) :: Rnorm !! If `MODE=1`, `RNORM` is the Euclidean length of the !! residual vector `AX-B`. When `MODE=2` or `3` RNORM` !! is set to zero. real ( wp ) :: rsq , s integer :: i , i1 , i2 , ie , ii , iopt , irm1 , ix , j , & jg , l , nerr , np1 real ( wp ), parameter :: zero = 0.0_wp main : block Rnorm = zero select case ( Mode ) case ( 1 ) ! ALG. STEP 26 do j = 1 , n x ( j ) = g ( j , Nb + 1 ) end do rsq = zero np1 = n + 1 irm1 = Ir - 1 if ( np1 <= irm1 ) then do j = np1 , irm1 rsq = rsq + g ( j , Nb + 1 ) ** 2 end do Rnorm = sqrt ( rsq ) end if case ( 2 ) do j = 1 , n s = zero if ( j /= 1 ) then i1 = max ( 1 , j - Nb + 1 ) i2 = j - 1 do i = i1 , i2 l = j - i + 1 + max ( 0 , i - Ip ) s = s + x ( i ) * g ( i , l ) end do end if l = max ( 0 , j - Ip ) if ( g ( j , l + 1 ) == 0 ) exit main x ( j ) = ( x ( j ) - s ) / g ( j , l + 1 ) end do return end select ! MODE = 3 do ii = 1 , n i = n + 1 - ii s = zero l = max ( 0 , i - Ip ) if ( i /= n ) then ie = min ( n + 1 - i , Nb ) do j = 2 , ie jg = j + l ix = i - 1 + j s = s + g ( i , jg ) * x ( ix ) end do end if if ( g ( i , l + 1 ) == 0 ) exit main x ( i ) = ( x ( i ) - s ) / g ( i , l + 1 ) end do return end block main ! error handling nerr = 1 iopt = 2 write ( * , * ) 'A zero diagonal term is in the n by n upper triangular matrix.' end subroutine dbndsl","tags":"","loc":"proc/dbndsl.html"},{"title":"dfspvn – bspline-fortran","text":"private subroutine dfspvn(t, Jhigh, Index, x, Ileft, Vnikx, j, deltam, deltap) Calculates the value of all possibly nonzero B-splines at X of\n order MAX(JHIGH,(J+1)(INDEX-1)) on T . Revision history 780801 DATE WRITTEN 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) JW : made threadsafe. See also dbspvn Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: t (*) integer, intent(in) :: Jhigh integer, intent(in) :: Index real(kind=wp), intent(in) :: x integer, intent(in) :: Ileft real(kind=wp) :: Vnikx (*) integer, intent(inout) :: j JW : added real(kind=wp), intent(inout), dimension(20) :: deltam JW : added real(kind=wp), intent(inout), dimension(20) :: deltap JW : added Called by proc~~dfspvn~~CalledByGraph proc~dfspvn bspline_defc_module::dfspvn proc~dcv bspline_defc_module::dcv proc~dcv->proc~dfspvn proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dfspvn proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dfspvn proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn->proc~dfspvd proc~dfspvd->proc~dfspvn proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfspvn ( t , Jhigh , Index , x , Ileft , Vnikx , j , deltam , deltap ) real ( wp ), intent ( in ) :: t ( * ) integer , intent ( in ) :: Jhigh integer , intent ( in ) :: Index real ( wp ), intent ( in ) :: x integer , intent ( in ) :: Ileft real ( wp ) :: Vnikx ( * ) integer , intent ( inout ) :: j !! JW : added real ( wp ), dimension ( 20 ), intent ( inout ) :: deltam , deltap !! JW : added real ( wp ) :: vm , vmprev integer :: imjp1 , ipj , jp1 , jp1ml , l if ( Index /= 2 ) then j = 1 Vnikx ( 1 ) = 1.0_wp if ( j >= Jhigh ) return end if do ipj = Ileft + j deltap ( j ) = t ( ipj ) - x imjp1 = Ileft - j + 1 deltam ( j ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = j + 1 do l = 1 , j jp1ml = jp1 - l vm = Vnikx ( l ) / ( deltap ( l ) + deltam ( jp1ml )) Vnikx ( l ) = vm * deltap ( l ) + vmprev vmprev = vm * deltam ( jp1ml ) end do Vnikx ( jp1 ) = vmprev j = jp1 if ( j >= Jhigh ) exit end do end subroutine dfspvn","tags":"","loc":"proc/dfspvn.html"},{"title":"dh12 – bspline-fortran","text":"private subroutine dh12(Mode, Lpivot, l1, m, u, Iue, Up, c, Ice, Icv, Ncv) Construction and/or application of a single\n Householder transformation. Q = I + U*(U**T)/B Reference C.L.Lawson and R.J.Hanson, Jet Propulsion Laboratory, 1973 Jun 12\n to appear in 'Solving Least Squares Problems', Prentice-Hall, 1974 Revision history 790101 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890831 Modified array declarations. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 900911 Added DDOT to real(wp) statement. (WRB) Arguments Type Intent Optional Attributes Name integer, intent(in) :: Mode 1 or 2 to select algorithm H1 or H2 . integer, intent(in) :: Lpivot the index of the pivot element. integer, intent(in) :: l1 If L1 <= M the transformation will be constructed to\nzero elements indexed from L1 through M . If L1 > M the subroutine does an identity transformation. integer, intent(in) :: m see l1 real(kind=wp), intent(inout) :: u (Iue,*) On entry to H1 U() contains the pivot vector.\nOn exit from H1 U() and UP contain quantities defining the vector U of the\nHouseholder transformation. On entry to H2 U() and UP should contain quantities previously computed\nby H1. These will not be modified by H2. integer, intent(in) :: Iue the storage increment between elements of U . real(kind=wp), intent(inout) :: Up see u real(kind=wp), intent(inout) :: c (*) On entry to H1 or H2 C() contains a matrix which will be\nregarded as a set of vectors to which the Householder\ntransformation is to be applied. On exit C() contains the\nset of transformed vectors. integer, intent(in) :: Ice Storage increment between elements of vectors in C() . integer, intent(in) :: Icv Storage increment between vectors in C() . integer, intent(in) :: Ncv Number of vectors in C() to be transformed. If NCV <= 0 no operations will be done on C() . Calls proc~~dh12~~CallsGraph proc~dh12 bspline_defc_module::dh12 proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dh12~~CalledByGraph proc~dh12 bspline_defc_module::dh12 proc~dbndac bspline_defc_module::dbndac proc~dbndac->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dhfti->proc~dh12 proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dh12 proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dh12 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dwnlit proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dbndac proc~dfcmn->proc~dlsei proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dlpdp->proc~dwnnls Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dh12 ( Mode , Lpivot , l1 , m , u , Iue , Up , c , Ice , Icv , Ncv ) integer , intent ( in ) :: Mode !! 1 or 2 to select algorithm H1 or H2 . integer , intent ( in ) :: Lpivot !! the index of the pivot element. integer , intent ( in ) :: l1 !! If `L1 <= M` the transformation will be constructed to !! zero elements indexed from `L1` through `M`. If `L1 > M` !! the subroutine does an identity transformation. integer , intent ( in ) :: m !! see `l1` integer , intent ( in ) :: Iue !! the storage increment between elements of `U`. real ( wp ), intent ( inout ) :: u ( Iue , * ) !! On entry to H1 `U()` contains the pivot vector. !! On exit from H1 `U()` and `UP` !! contain quantities defining the vector `U` of the !! Householder transformation. On entry to H2 `U()` !! and `UP` should contain quantities previously computed !! by H1. These will not be modified by H2. real ( wp ), intent ( inout ) :: Up !! see `u` real ( wp ), intent ( inout ) :: c ( * ) !! On entry to H1 or H2 `C()` contains a matrix which will be !! regarded as a set of vectors to which the Householder !! transformation is to be applied. On exit `C()` contains the !! set of transformed vectors. integer , intent ( in ) :: Ice !! Storage increment between elements of vectors in `C()`. integer , intent ( in ) :: Icv !! Storage increment between vectors in `C()`. integer , intent ( in ) :: Ncv !! Number of vectors in `C()` to be transformed. If `NCV <= 0` !! no operations will be done on `C()`. integer :: i , i2 , i3 , i4 , incr , j , kl1 , & kl2 , klp , l1m1 , mml1p2 real ( wp ) :: b , cl , clinv , ul1m1 , sm real ( wp ), parameter :: one = 1.0_wp if ( 0 < Lpivot . and . Lpivot < l1 . and . l1 <= m ) then cl = abs ( u ( 1 , Lpivot )) if ( Mode /= 2 ) then ! ****** CONSTRUCT THE TRANSFORMATION. ****** do j = l1 , m cl = max ( abs ( u ( 1 , j )), cl ) end do if ( cl <= 0.0_wp ) return clinv = one / cl sm = ( u ( 1 , Lpivot ) * clinv ) ** 2 do j = l1 , m sm = sm + ( u ( 1 , j ) * clinv ) ** 2 end do cl = cl * sqrt ( sm ) if ( u ( 1 , Lpivot ) > 0.0_wp ) cl = - cl Up = u ( 1 , Lpivot ) - cl u ( 1 , Lpivot ) = cl ! ****** APPLY THE TRANSFORMATION I+U*(U**T)/B TO C. ****** elseif ( cl <= 0.0_wp ) then return end if if ( Ncv > 0 ) then b = Up * u ( 1 , Lpivot ) ! B MUST BE NONPOSITIVE HERE. IF B = 0., RETURN. if ( b < 0.0_wp ) then b = one / b mml1p2 = m - l1 + 2 if ( mml1p2 <= 20 ) then i2 = 1 - Icv + Ice * ( Lpivot - 1 ) incr = Ice * ( l1 - Lpivot ) do j = 1 , Ncv i2 = i2 + Icv i3 = i2 + incr i4 = i3 sm = c ( i2 ) * Up do i = l1 , m sm = sm + c ( i3 ) * u ( 1 , i ) i3 = i3 + Ice end do if ( sm /= 0.0_wp ) then sm = sm * b c ( i2 ) = c ( i2 ) + sm * Up do i = l1 , m c ( i4 ) = c ( i4 ) + sm * u ( 1 , i ) i4 = i4 + Ice end do end if end do else l1m1 = l1 - 1 kl1 = 1 + ( l1m1 - 1 ) * Ice kl2 = kl1 klp = 1 + ( Lpivot - 1 ) * Ice ul1m1 = u ( 1 , l1m1 ) u ( 1 , l1m1 ) = Up if ( Lpivot /= l1m1 ) call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) do j = 1 , Ncv sm = ddot ( mml1p2 , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) sm = sm * b call daxpy ( mml1p2 , sm , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) kl1 = kl1 + Icv end do u ( 1 , l1m1 ) = ul1m1 if ( Lpivot /= l1m1 ) then kl1 = kl2 call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) end if end if end if end if end if end subroutine dh12","tags":"","loc":"proc/dh12.html"},{"title":"dsort – bspline-fortran","text":"private subroutine dsort(n, Kflag, Dx, Dy) Sort an array and optionally make the same interchanges in\n an auxiliary array. The array may be sorted in increasing\n or decreasing order. History 29-dec-2022 : Replaced original routines.\n Now just a wraper for sort_ascending recursive quicksort (JW) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n number of values in array DX to be sorted integer, intent(in) :: Kflag control parameter:\n * Kflag < 0 : sort DX in decreasing order and optionally carry DY along.\n * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real(kind=wp), intent(inout), dimension(*) :: Dx array of values to be sorted (usually abscissas) real(kind=wp), intent(inout), optional, dimension(*) :: Dy array to be (optionally) carried along Calls proc~~dsort~~CallsGraph proc~dsort bspline_defc_module::dsort proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dsort~~CalledByGraph proc~dsort bspline_defc_module::dsort proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dsort proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dsort proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dsort ( n , Kflag , Dx , Dy ) implicit none integer , intent ( in ) :: n !! number of values in array DX to be sorted integer , intent ( in ) :: Kflag !! control parameter: !! * Kflag < 0 : sort DX in decreasing order and optionally carry DY along. !! * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real ( wp ), dimension ( * ), intent ( inout ) :: Dx !! array of values to be sorted (usually abscissas) real ( wp ), dimension ( * ), intent ( inout ), optional :: Dy !! array to be (optionally) carried along if ( n < 1 ) then write ( * , * ) 'The number of values to be sorted is not positive.' return end if if ( abs ( Kflag ) == 0 ) then write ( * , * ) 'The sort control parameter, K, cannot be 0.' return end if ! Alter array DX to get decreasing order if needed if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) call sort_ascending ( n , Dx , Dy ) if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) end subroutine dsort","tags":"","loc":"proc/dsort.html"},{"title":"sort_ascending – bspline-fortran","text":"private subroutine sort_ascending(n, dx, dy) Recursive quicksoft.\n Modified to also carry along a second array. Author Jacob Williams Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=wp), intent(inout), dimension(*) :: dx array of values to be sorted real(kind=wp), intent(inout), optional, dimension(*) :: dy array to be (optionally) carried along Called by proc~~sort_ascending~~CalledByGraph proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort bspline_defc_module::dsort proc~dsort->proc~sort_ascending proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dsort proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dsort proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine sort_ascending ( n , dx , dy ) integer , intent ( in ) :: n real ( wp ), dimension ( * ), intent ( inout ) :: dx !! array of values to be sorted real ( wp ), dimension ( * ), intent ( inout ), optional :: dy !! array to be (optionally) carried along logical :: carry_dy !! if `dy` is to be also sorted integer , parameter :: max_size_for_insertion_sort = 20 !! max size for using insertion sort. !! (otherwise, use quicksort) carry_dy = present ( dy ) call quicksort ( 1 , n ) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array (ascending order). integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer :: ipivot !! pivot element integer :: i !! counter integer :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( dx ( j ) < dx ( j - 1 )) then call swap ( dx ( j ), dx ( j - 1 )) if ( carry_dy ) call swap ( dy ( j ), dy ( j - 1 )) else exit end if end do end do else if ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1 ) call quicksort ( ipivot + 1 , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer , intent ( out ) :: ipivot integer :: i , ip , im im = ( ilow + ihigh ) / 2 call swap ( dx ( ilow ), dx ( im )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( im )) ip = ilow do i = ilow + 1 , ihigh if ( dx ( i ) < dx ( ilow )) then ip = ip + 1 call swap ( dx ( ip ), dx ( i )) if ( carry_dy ) call swap ( dy ( ip ), dy ( i )) end if end do call swap ( dx ( ilow ), dx ( ip )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( ip )) ipivot = ip end subroutine partition subroutine swap ( v1 , v2 ) !! swap two real values real ( wp ), intent ( inout ) :: v1 real ( wp ), intent ( inout ) :: v2 real ( wp ) :: tmp tmp = v1 v1 = v2 v2 = tmp end subroutine swap end subroutine sort_ascending","tags":"","loc":"proc/sort_ascending.html"},{"title":"dfc – bspline-fortran","text":"public subroutine dfc(ndata, xdata, ydata, sddata, nord, Nbkpt, Bkpt, nconst, xconst, yconst, nderiv, mode, coeff, w, iw) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense.\n Equality and inequality constraints can be imposed on the\n fitted curve. Evaluating the Variance Function To evaluate the variance function (assuming\n that the uncertainties of the Y values were\n provided to DFC and an input value of\n MODE=2 or 4 was used), use the function\n subprogram DCV var = dcv ( xval , ndata , nconst , nord , nbkpt , bkpt , w ) Here XVAL is the point where the variance is\n desired. The other arguments have the same\n meaning as in the usage of DFC . For those users employing the old problem\n designation, let MDATA be the number of data\n points in the problem. (This may be different\n from NDATA if the old problem designation\n feature was used.) The value, VAR, should be\n multiplied by the quantity DBLE(MAX(NDATA-N,1))/DBLE(MAX(MDATA-N,1)) The output of this subprogram is not defined\n if an input value of MODE=1 or 3 was used in\n FC( ) or if an output value of MODE=-1, 2, or\n 3 was obtained. The variance function, except\n for the scaling factor noted above, is given\n by VAR=(transpose of B(XVAL))*C*B(XVAL) The vector B(XVAL) is the B-spline basis\n function values at X=XVAL.\n The covariance matrix, C, of the solution\n coefficients accounts only for the least\n squares equations and the explicitly stated\n equality constraints. This fact must be\n considered when interpreting the variance\n function from a data fitting problem that has\n inequality constraints on the fitted curve. Evaluating the Fitted Curve Refer to the defc header Revision history 780801 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900510 Convert references to XERRWV to references to XERMSG. (RWC) 900607 Editorial changes to Prologue to make Prologues for EFC,\n DEFC, FC, and DFC look as much the same as possible. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name integer, intent(in) :: ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in) :: xdata (*) X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in) :: ydata (*) Y data array. real(kind=wp), intent(in) :: sddata (*) Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(*) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: nconst The number of conditions that constrain the\nB-spline is NCONST. A constraint is specified\nby an (X,Y) pair in the arrays XCONST( ) and\nYCONST( ), and by the type of constraint and\nderivative value encoded in the array\nNDERIV(*). real(kind=wp), intent(in) :: xconst (*) X value of constraint.\nNo sorting of XCONST(*) is required. real(kind=wp), intent(in) :: yconst (*) Y value of constraint integer, intent(in) :: nderiv (*) The value of NDERIV(*) is\n determined as follows. Suppose the I-th\n constraint applies to the J-th derivative\n of the B-spline. (Any non-negative value of\n J < NORD is permitted. In particular the\n value J=0 refers to the B-spline itself.)\n For this I-th constraint, set XCONST(I)=X,\n YCONST(I)=Y, and\n NDERIV(I)=ITYPE+4*J, where\n\n ITYPE = 0, if (J-th deriv. at X) <= Y.\n = 1, if (J-th deriv. at X) >= Y.\n = 2, if (J-th deriv. at X) == Y.\n = 3, if (J-th deriv. at X) ==\n (J-th deriv. at Y). (A value of NDERIV(I)=-1 will cause this\n constraint to be ignored. This subprogram\n feature is often useful when temporarily\n suppressing a constraint while still\n retaining the source code of the calling\n program.) integer, intent(inout) :: mode Input An input flag that directs the least squares\nsolution method used by DFC . The variance function, referred to below,\ndefines the square of the probable error of\nthe fitted curve at any point, XVAL.\nThis feature of DFC allows one to use the\nsquare root of this variance function to\ndetermine a probable error band around the\nfitted curve. =1 a new problem. No variance function. =2 a new problem. Want variance function. =3 an old problem. No variance function. =4 an old problem. Want variance function. Any value of MODE other than 1-4 is an error. The user with a new problem can skip directly\nto the description of the input parameters\nIW(1), IW(2). If the user correctly specifies the new or old\nproblem status, the subprogram DFC will\nperform more efficiently.\nBy an old problem it is meant that subprogram DFC was last called with this same set of\nknots, data points and weights. Another often useful deployment of this old\nproblem designation can occur when one has\npreviously obtained a Q-R orthogonal\ndecomposition of the matrix resulting from\nB-spline fitting of data (without constraints)\nat the breakpoints BKPT(I), I=1,...,NBKPT.\nFor example, this matrix could be the result\nof sequential accumulation of the least\nsquares equations for a very large data set.\nThe user writes this code in a manner\nconvenient for the application. For the\ndiscussion here let N=NBKPT-NORD, and K=N+3 Let us assume that an equivalent least squares\nsystem RC=D has been obtained. Here R is an N+1 by N\nmatrix and D is a vector with N+1 components.\nThe last row of R is zero. The matrix R is\nupper triangular and banded. At most NORD of\nthe diagonals are nonzero.\nThe contents of R and D can be copied to the\nworking array W(*) as follows. The I-th diagonal of R, which has N-I+1\nelements, is copied to W(*) starting at W((I-1)*K+1), for I=1,...,NORD.\nThe vector D is copied to W(*) starting at W(NORD*K+1) The input value used for NDATA is arbitrary\nwhen an old problem is designated. Because\nof the feature of DFC that checks the\nworking storage array lengths, a value not\nexceeding NBKPT should be used. For example,\nuse NDATA=0. (The constraints or variance function request\ncan change in each call to DFC .) A new\nproblem is anything other than an old problem. Output An output flag that indicates the status\nof the constrained curve fit. =-1 a usage error of DFC occurred. The\n offending condition is noted with the\n SLATEC library error processor, XERMSG.\n In case the working arrays W( ) or IW( )\n are not long enough, the minimal\n acceptable length is printed. = 0 successful constrained curve fit. = 1 the requested equality constraints\n are contradictory. = 2 the requested inequality constraints\n are contradictory. = 3 both equality and inequality constraints\n are contradictory. real(kind=wp), intent(out) :: coeff (*) If the output value of MODE=0 or 1, this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD\nparameters are the B-spline coefficients.\nFor MODE=1, the equality constraints are\ncontradictory. To make the fitting process\nmore robust, the equality constraints are\nsatisfied in a least squares sense. In this\ncase the array COEFF( ) contains B-spline\ncoefficients for this extended concept of a\nsolution. If MODE=-1,2 or 3 on output, the\narray COEFF( ) is undefined. real(kind=wp) :: w (*) real work array of length IW(1) . The\n contents of W(*) must not be modified by the\n user if the variance function is desired. The length of W(*) must be at least NB=(NBKPT-NORD+3)*(NORD+1)+\n 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 Whenever possible the code uses banded matrix\n processors DBNDAC( ) and DBNDSL( ). These\n are utilized if there are no constraints,\n no variance function is required, and there\n is sufficient data to uniquely determine the\n B-spline coefficients. If the band processors\n cannot be used to determine the solution,\n then the constrained least squares code DLSEI\n is used. In this case the subprogram requires\n an additional block of storage in W(*). For\n the discussion here define the integers NEQCON\n and NINCON respectively as the number of\n equality (ITYPE=2,3) and inequality\n (ITYPE=0,1) constraints imposed on the fitted\n curve. Define L = NBKPT-NORD+1 and note that NCONST = NEQCON+NINCON When the subprogram DFC uses DLSEI the\n length of the working array W(*) must be at\n least LW = NB+(L+NCONST)*L+2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6) integer :: iw (*) integer work array of length IW(2) IW(1),IW(2) are the amounts of working storage actually\nallocated for the working arrays W( ) and\nIW( ). These quantities are compared with the\nactual amounts of storage needed in DFC .\nInsufficient storage allocated for either\nW( ) or IW( ) is an error. This feature was\nincluded in DFC because misreading the\nstorage formulas for W( ) and IW( ) might very\nwell lead to subtle and hard-to-find\nprogramming bugs. The length of the array IW(*) must be at least IW1 = NINCON+2*L in any case. Calls proc~~dfc~~CallsGraph proc~dfc bspline_defc_module::dfc proc~dfcmn bspline_defc_module::dfcmn proc~dfc->proc~dfcmn proc~daxpy bspline_blas_module::daxpy proc~dfcmn->proc~daxpy proc~dbndac bspline_defc_module::dbndac proc~dfcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~dfcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~dfcmn->proc~dcopy proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn->proc~dfspvd proc~dfspvn bspline_defc_module::dfspvn proc~dfcmn->proc~dfspvn proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dscal bspline_blas_module::dscal proc~dfcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~dfcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~dfspvd->proc~dfspvn proc~dlsei->proc~daxpy proc~dlsei->proc~dcopy proc~dlsei->proc~dscal proc~dasum bspline_blas_module::dasum proc~dlsei->proc~dasum proc~ddot bspline_blas_module::ddot proc~dlsei->proc~ddot proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dnrm2 bspline_blas_module::dnrm2 proc~dlsei->proc~dnrm2 proc~dswap bspline_blas_module::dswap proc~dlsei->proc~dswap proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dlsi->proc~daxpy proc~dlsi->proc~dcopy proc~dlsi->proc~dscal proc~dlsi->proc~dasum proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dswap proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~dscal proc~dlpdp->proc~ddot proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dasum proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dswap proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dscal proc~dwnlit->proc~dh12 proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfc ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , & nconst , xconst , yconst , nderiv , mode , coeff , w , iw ) integer , intent ( in ) :: ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), intent ( in ) :: xdata ( * ) !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), intent ( in ) :: ydata ( * ) !! Y data array. real ( wp ), intent ( in ) :: sddata ( * ) !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension ( * ), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: nconst !! The number of conditions that constrain the !! B-spline is NCONST. A constraint is specified !! by an (X,Y) pair in the arrays XCONST(*) and !! YCONST(*), and by the type of constraint and !! derivative value encoded in the array !! NDERIV(*). real ( wp ), intent ( in ) :: xconst ( * ) !! X value of constraint. !! No sorting of XCONST(*) is required. real ( wp ), intent ( in ) :: yconst ( * ) !! Y value of constraint integer , intent ( in ) :: nderiv ( * ) !! The value of NDERIV(*) is !! determined as follows. Suppose the I-th !! constraint applies to the J-th derivative !! of the B-spline. (Any non-negative value of !! J < NORD is permitted. In particular the !! value J=0 refers to the B-spline itself.) !! For this I-th constraint, set !!``` !! XCONST(I)=X, !! YCONST(I)=Y, and !! NDERIV(I)=ITYPE+4*J, where !! !! ITYPE = 0, if (J-th deriv. at X) <= Y. !! = 1, if (J-th deriv. at X) >= Y. !! = 2, if (J-th deriv. at X) == Y. !! = 3, if (J-th deriv. at X) == !! (J-th deriv. at Y). !!``` !! (A value of NDERIV(I)=-1 will cause this !! constraint to be ignored. This subprogram !! feature is often useful when temporarily !! suppressing a constraint while still !! retaining the source code of the calling !! program.) integer , intent ( inout ) :: mode !! *Input* !! !! An input flag that directs the least squares !! solution method used by [[DFC]]. !! !! The variance function, referred to below, !! defines the square of the probable error of !! the fitted curve at any point, XVAL. !! This feature of [[DFC]] allows one to use the !! square root of this variance function to !! determine a probable error band around the !! fitted curve. !! !! * `=1` a new problem. No variance function. !! * `=2` a new problem. Want variance function. !! * `=3` an old problem. No variance function. !! * `=4` an old problem. Want variance function. !! !! Any value of MODE other than 1-4 is an error. !! !! The user with a new problem can skip directly !! to the description of the input parameters !! IW(1), IW(2). !! !! If the user correctly specifies the new or old !! problem status, the subprogram [[DFC]] will !! perform more efficiently. !! By an old problem it is meant that subprogram !! [[DFC]] was last called with this same set of !! knots, data points and weights. !! !! Another often useful deployment of this old !! problem designation can occur when one has !! previously obtained a Q-R orthogonal !! decomposition of the matrix resulting from !! B-spline fitting of data (without constraints) !! at the breakpoints BKPT(I), I=1,...,NBKPT. !! For example, this matrix could be the result !! of sequential accumulation of the least !! squares equations for a very large data set. !! The user writes this code in a manner !! convenient for the application. For the !! discussion here let !! !! `N=NBKPT-NORD, and K=N+3` !! !! Let us assume that an equivalent least squares !! system !! !! `RC=D` !! !! has been obtained. Here R is an N+1 by N !! matrix and D is a vector with N+1 components. !! The last row of R is zero. The matrix R is !! upper triangular and banded. At most NORD of !! the diagonals are nonzero. !! The contents of R and D can be copied to the !! working array W(*) as follows. !! !! The I-th diagonal of R, which has N-I+1 !! elements, is copied to W(*) starting at !! !! `W((I-1)*K+1),` !! !! for I=1,...,NORD. !! The vector D is copied to W(*) starting at !! !! `W(NORD*K+1)` !! !! The input value used for NDATA is arbitrary !! when an old problem is designated. Because !! of the feature of [[DFC]] that checks the !! working storage array lengths, a value not !! exceeding NBKPT should be used. For example, !! use NDATA=0. !! !! (The constraints or variance function request !! can change in each call to [[DFC]].) A new !! problem is anything other than an old problem. !! !! *Output* !! !! An output flag that indicates the status !! of the constrained curve fit. !! !! * `=-1` a usage error of [[DFC]] occurred. The !! offending condition is noted with the !! SLATEC library error processor, XERMSG. !! In case the working arrays W(*) or IW(*) !! are not long enough, the minimal !! acceptable length is printed. !! * `= 0` successful constrained curve fit. !! * `= 1` the requested equality constraints !! are contradictory. !! * `= 2` the requested inequality constraints !! are contradictory. !! * `= 3` both equality and inequality constraints !! are contradictory. real ( wp ), intent ( out ) :: coeff ( * ) !! If the output value of MODE=0 or 1, this array !! contains the unknowns obtained from the least !! squares fitting process. These N=NBKPT-NORD !! parameters are the B-spline coefficients. !! For MODE=1, the equality constraints are !! contradictory. To make the fitting process !! more robust, the equality constraints are !! satisfied in a least squares sense. In this !! case the array COEFF(*) contains B-spline !! coefficients for this extended concept of a !! solution. If MODE=-1,2 or 3 on output, the !! array COEFF(*) is undefined. real ( wp ) :: w ( * ) !! real work array of length `IW(1)`. The !! contents of `W(*)` must not be modified by the !! user if the variance function is desired. !! !! The length of W(*) must be at least !!``` !! NB=(NBKPT-NORD+3)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` !! Whenever possible the code uses banded matrix !! processors DBNDAC( ) and DBNDSL( ). These !! are utilized if there are no constraints, !! no variance function is required, and there !! is sufficient data to uniquely determine the !! B-spline coefficients. If the band processors !! cannot be used to determine the solution, !! then the constrained least squares code DLSEI !! is used. In this case the subprogram requires !! an additional block of storage in W(*). For !! the discussion here define the integers NEQCON !! and NINCON respectively as the number of !! equality (ITYPE=2,3) and inequality !! (ITYPE=0,1) constraints imposed on the fitted !! curve. Define !! !! `L = NBKPT-NORD+1` !! !! and note that !! !! `NCONST = NEQCON+NINCON` !! !! When the subprogram [[DFC]] uses [[DLSEI]] the !! length of the working array W(*) must be at !! least !! !! `LW = NB+(L+NCONST)*L+2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6)` integer :: iw ( * ) !! integer work array of length `IW(2)` !! !! `IW(1),IW(2)` are the amounts of working storage actually !! allocated for the working arrays W(*) and !! IW(*). These quantities are compared with the !! actual amounts of storage needed in [[DFC]]. !! Insufficient storage allocated for either !! W(*) or IW(*) is an error. This feature was !! included in [[DFC]] because misreading the !! storage formulas for W(*) and IW(*) might very !! well lead to subtle and hard-to-find !! programming bugs. !! !! The length of the array IW(*) must be at least !! !! `IW1 = NINCON+2*L` !! !! in any case. integer :: i1 , i2 , i3 , i4 , i5 , i6 , i7 , mdg , mdw mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst ! USAGE IN DFCMN( ) OF W(*).. ! I1,...,I2-1 G(*,*) ! I2,...,I3-1 XTEMP(*) ! I3,...,I4-1 PTEMP(*) ! I4,...,I5-1 BKPT(*) (LOCAL TO [[DFCMN]]) ! I5,...,I6-1 BF(*,*) ! I6,...,I7-1 W(*,*) ! I7,... WORK(*) FOR [[DLSEI]] i1 = 1 i2 = i1 + mdg * ( nord + 1 ) i3 = i2 + max ( ndata , nbkpt ) i4 = i3 + max ( ndata , nbkpt ) i5 = i4 + nbkpt i6 = i5 + nord * nord i7 = i6 + mdw * ( nbkpt - nord + 1 ) call dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , nconst , & xconst , yconst , nderiv , mode , coeff , w ( i5 ), w ( i2 ), w ( i3 ), & w ( i4 ), w ( i1 ), mdg , w ( i6 ), mdw , w ( i7 ), iw ) end subroutine dfc","tags":"","loc":"proc/dfc.html"},{"title":"dfcmn – bspline-fortran","text":"private subroutine dfcmn(ndata, xdata, ydata, sddata, nord, nbkpt, bkptin, nconst, xconst, yconst, nderiv, mode, coeff, bf, xtemp, ptemp, bkpt, g, mdg, w, mdw, work, iwork) This is a companion subprogram to DFC .\n The documentation for DFC has complete usage instructions. Revision history 780801 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900328 Added TYPE section. (WRB) 900510 Convert XERRWV calls to XERMSG calls. (RWC) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer :: ndata real(kind=wp) :: xdata (*) real(kind=wp) :: ydata (*) real(kind=wp) :: sddata (*) integer :: nord integer :: nbkpt real(kind=wp) :: bkptin (*) integer :: nconst real(kind=wp) :: xconst (*) real(kind=wp) :: yconst (*) integer :: nderiv (*) integer :: mode real(kind=wp) :: coeff (*) real(kind=wp) :: bf (nord,*) real(kind=wp) :: xtemp (*) real(kind=wp) :: ptemp (*) real(kind=wp) :: bkpt (*) real(kind=wp) :: g (mdg,*) integer :: mdg real(kind=wp) :: w (mdw,*) integer :: mdw real(kind=wp) :: work (*) integer :: iwork (*) Calls proc~~dfcmn~~CallsGraph proc~dfcmn bspline_defc_module::dfcmn proc~daxpy bspline_blas_module::daxpy proc~dfcmn->proc~daxpy proc~dbndac bspline_defc_module::dbndac proc~dfcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~dfcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~dfcmn->proc~dcopy proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn->proc~dfspvd proc~dfspvn bspline_defc_module::dfspvn proc~dfcmn->proc~dfspvn proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dscal bspline_blas_module::dscal proc~dfcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~dfcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~dfspvd->proc~dfspvn proc~dlsei->proc~daxpy proc~dlsei->proc~dcopy proc~dlsei->proc~dscal proc~dasum bspline_blas_module::dasum proc~dlsei->proc~dasum proc~ddot bspline_blas_module::ddot proc~dlsei->proc~ddot proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dnrm2 bspline_blas_module::dnrm2 proc~dlsei->proc~dnrm2 proc~dswap bspline_blas_module::dswap proc~dlsei->proc~dswap proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dlsi->proc~daxpy proc~dlsi->proc~dcopy proc~dlsi->proc~dscal proc~dlsi->proc~dasum proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dswap proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~dscal proc~dlpdp->proc~ddot proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dasum proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dswap proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dscal proc~dwnlit->proc~dh12 proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dfcmn~~CalledByGraph proc~dfcmn bspline_defc_module::dfcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , & bkptin , nconst , xconst , yconst , nderiv , mode , coeff , bf , xtemp , & ptemp , bkpt , g , mdg , w , mdw , work , iwork ) integer :: iwork ( * ), mdg , mdw , mode , nbkpt , nconst , ndata , nderiv ( * ), & nord real ( wp ) :: bf ( nord , * ), bkpt ( * ), bkptin ( * ), coeff ( * ), & g ( mdg , * ), ptemp ( * ), sddata ( * ), w ( mdw , * ), work ( * ), & xconst ( * ), xdata ( * ), xtemp ( * ), yconst ( * ), ydata ( * ) real ( wp ) :: prgopt ( 10 ), rnorm , rnorme , rnorml , xmax , & xmin , xval , yval integer :: i , idata , ideriv , ileft , intrvl , intw1 , ip , ir , irow , & itype , iw1 , iw2 , l , lw , mt , n , nb , neqcon , nincon , nordm1 , & nordp1 , np1 logical :: band , new , var character ( len = 8 ) :: xern1 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Analyze input. if ( nord < 1 . or . nord > 20 ) then write ( * , * ) 'IN DFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' mode = - 1 return elseif ( nbkpt < 2 * nord ) then write ( * , * ) 'IN DFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE ' // & 'THE B-SPLINE ORDER.' mode = - 1 return endif if ( ndata < 0 ) then write ( * , * ) 'IN DFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' mode = - 1 return endif ! Amount of storage allocated for W(*), IW(*). iw1 = iwork ( 1 ) iw2 = iwork ( 2 ) nb = ( nbkpt - nord + 3 ) * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + & nord ** 2 ! See if sufficient storage has been allocated. if ( iw1 < nb ) then write ( xern1 , '(I8)' ) nb write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK NB = ' // xern1 mode = - 1 return endif select case ( mode ) case ( 1 ) band = . true . var = . false . new = . true . case ( 2 ) band = . false . var = . true . new = . true . case ( 3 ) band = . true . var = . false . new = . false . case ( 4 ) band = . false . var = . true . new = . false . case default write ( * , * ) 'IN DFC, INPUT VALUE OF MODE MUST BE 1-4.' mode = - 1 return end select mode = 0 ! Sort the breakpoints. call dcopy ( nbkpt , bkptin , 1 , bkpt , 1 ) call dsort ( nbkpt , 1 , bkpt ) ! Initialize variables. neqcon = 0 nincon = 0 do i = 1 , nconst l = nderiv ( i ) itype = mod ( l , 4 ) if ( itype < 2 ) then nincon = nincon + 1 else neqcon = neqcon + 1 endif end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Compute the number of variables. n = nbkpt - nord np1 = n + 1 lw = nb + ( np1 + nconst ) * np1 + 2 * ( neqcon + np1 ) + ( nincon + np1 ) + & ( nincon + 2 ) * ( np1 + 6 ) intw1 = nincon + 2 * np1 ! Save interval containing knots. xmin = bkpt ( nord ) xmax = bkpt ( np1 ) ! Find the smallest referenced independent variable value in any ! constraint. do i = 1 , nconst xmin = min ( xmin , xconst ( i )) xmax = max ( xmax , xconst ( i )) end do nordm1 = nord - 1 nordp1 = nord + 1 ! Define the option vector PRGOPT(1-10) for use in [[DLSEI]]. prgopt ( 1 ) = 4 ! Set the covariance matrix computation flag. prgopt ( 2 ) = 1 if ( var ) then prgopt ( 3 ) = 1 else prgopt ( 3 ) = 0 endif ! Increase the rank determination tolerances for both equality ! constraint equations and least squares equations. prgopt ( 4 ) = 7 prgopt ( 5 ) = 4 prgopt ( 6 ) = 1.0e-4_wp prgopt ( 7 ) = 10 prgopt ( 8 ) = 5 prgopt ( 9 ) = 1.0e-4_wp prgopt ( 10 ) = 1 ! Turn off work array length checking in [[DLSEI]]. iwork ( 1 ) = 0 iwork ( 2 ) = 0 ! Initialize variables and analyze input. if ( new ) then ! To process least squares equations sort data and an array of ! pointers. call dcopy ( ndata , xdata , 1 , xtemp , 1 ) do i = 1 , ndata ptemp ( i ) = i end do if ( ndata > 0 ) then call dsort ( ndata , 2 , xtemp , ptemp ) xmin = min ( xmin , xtemp ( 1 )) xmax = max ( xmax , xtemp ( ndata )) endif ! Fix breakpoint array if needed. do i = 1 , nord bkpt ( i ) = min ( bkpt ( i ), xmin ) end do do i = np1 , nbkpt bkpt ( i ) = max ( bkpt ( i ), xmax ) end do ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = nord do idata = 1 , ndata ! Sorted indices are in PTEMP(*). l = ptemp ( idata ) xval = xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= bkpt ( ileft + 1 )) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ! ILEFT= bkpt ( ileft + 1 ) . and . ileft < n ) then ileft = ileft + 1 else exit endif end do endif ! Obtain B-spline function value. call dfspvn ( bkpt , nord , 1 , xval , ileft , bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( nord , bf , 1 , g ( irow , 1 ), mdg ) g ( irow , nordp1 ) = ydata ( l ) ! Scale data if uncertainty is nonzero. if ( sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / sddata ( l ), & g ( irow , 1 ), mdg ) ! When staging work area is exhausted, process rows. if ( irow == mdg - 1 ) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 endif end do ! Process last block of equations. call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), mdg ) call dbndac ( g , mdg , nord , ip , ir , 1 , np1 ) endif band = band . and . nconst == 0 do i = 1 , n band = band . and . g ( i , 1 ) /= 0.0_wp end do ! Process banded least squares equations. if ( band ) then call dbndsl ( 1 , g , mdg , nord , ip , ir , coeff , n , rnorm ) return endif ! Check further for sufficient storage in working arrays. if ( iw1 < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK LW = ' // xern1 mode = - 1 return endif if ( iw2 < intw1 ) then write ( xern1 , '(I8)' ) intw1 write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR IW(*). CHECK IW1 = ' // xern1 mode = - 1 return endif ! Write equality constraints. ! Analyze constraint indicators for an equality constraint. neqcon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype > 1 ) then ideriv = l / 4 neqcon = neqcon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) call dcopy ( np1 , [ 0.0_wp ], 0 , w ( neqcon , 1 ), mdw ) call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( neqcon , ileft - nordm1 ), & mdw ) if ( itype == 2 ) then w ( neqcon , np1 ) = yconst ( idata ) else ileft = nord yval = yconst ( idata ) do if ( yval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , yval , ileft , bf , ideriv + 1 ) call daxpy ( nord , - 1.0_wp , bf ( 1 , ideriv + 1 ), 1 , & w ( neqcon , ileft - nordm1 ), mdw ) endif endif end do ! Transfer least squares data. do i = 1 , np1 irow = i + neqcon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) call dcopy ( min ( np1 - i , nord ), g ( i , 1 ), mdg , w ( irow , i ), mdw ) w ( irow , np1 ) = g ( i , nordp1 ) end do ! Write inequality constraints. ! Analyze constraint indicators for inequality constraints. nincon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype < 2 ) then ideriv = l / 4 nincon = nincon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) irow = neqcon + np1 + nincon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) intrvl = ileft - nordm1 call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( irow , intrvl ), mdw ) if ( itype == 1 ) then w ( irow , np1 ) = yconst ( idata ) else w ( irow , np1 ) = - yconst ( idata ) call dscal ( nord , - 1.0_wp , w ( irow , intrvl ), mdw ) endif endif end do ! Solve constrained least squares equations. call dlsei ( w , mdw , neqcon , np1 , nincon , n , prgopt , coeff , rnorme , & rnorml , mode , work , iwork ) end subroutine dfcmn","tags":"","loc":"proc/dfcmn.html"},{"title":"dfspvd – bspline-fortran","text":"private subroutine dfspvd(t, k, x, ileft, vnikx, nderiv) Calculates value and derivs of all B-splines which do not vanish at X Fill VNIKX(J,IDERIV), J=IDERIV, ... ,K with nonzero values of\n B-splines of order K+1-IDERIV , IDERIV=NDERIV, ... ,1 , by repeated\n calls to DFSPVN Revision history 780801 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890831 Modified array declarations. (WRB) 890911 Removed unnecessary intrinsics. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: t (*) integer :: k real(kind=wp) :: x integer :: ileft real(kind=wp) :: vnikx (k,*) integer :: nderiv Calls proc~~dfspvd~~CallsGraph proc~dfspvd bspline_defc_module::dfspvd proc~dfspvn bspline_defc_module::dfspvn proc~dfspvd->proc~dfspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dfspvd~~CalledByGraph proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dfspvd proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfspvd ( t , k , x , ileft , vnikx , nderiv ) real ( wp ) :: t ( * ) integer :: k real ( wp ) :: x integer :: ileft real ( wp ) :: vnikx ( k , * ) integer :: nderiv real ( wp ) :: a ( 20 , 20 ) integer :: ideriv , idervm , i , j , kmd , m , jm1 , ipkmd , l , jlow real ( wp ) :: fkmd , diff , v integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp call dfspvn ( t , k + 1 - nderiv , 1 , x , ileft , vnikx ( nderiv , nderiv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) if ( nderiv <= 1 ) return ideriv = nderiv do i = 2 , nderiv idervm = ideriv - 1 do j = ideriv , k vnikx ( j - 1 , idervm ) = vnikx ( j , ideriv ) end do ideriv = idervm call dfspvn ( t , 0 , 2 , x , ileft , vnikx ( ideriv , ideriv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) end do do i = 1 , k do j = 1 , k a ( i , j ) = 0.0_wp end do a ( i , i ) = 1.0_wp end do kmd = k do m = 2 , nderiv kmd = kmd - 1 fkmd = kmd i = ileft j = k do jm1 = j - 1 ipkmd = i + kmd diff = t ( ipkmd ) - t ( i ) if ( jm1 == 0 ) exit if ( diff /= 0.0_wp ) then do l = 1 , j a ( l , j ) = ( a ( l , j ) - a ( l , j - 1 )) / diff * fkmd end do end if j = jm1 i = i - 1 end do if ( diff /= 0.0_wp ) then a ( 1 , 1 ) = a ( 1 , 1 ) / diff * fkmd end if do i = 1 , k v = 0.0_wp jlow = max ( i , m ) do j = jlow , k v = a ( i , j ) * vnikx ( j , m ) + v end do vnikx ( i , m ) = v end do end do end subroutine dfspvd","tags":"","loc":"proc/dfspvd.html"},{"title":"dhfti – bspline-fortran","text":"private subroutine dhfti(a, mda, m, n, b, mdb, nb, tau, krank, rnorm, h, g, ip) Solve a least squares problem for banded matrices using\n sequential accumulation of rows of the data matrix.\n Exactly one right-hand side vector is permitted. This subroutine solves a linear least squares problem or a set of\n linear least squares problems having the same matrix but different\n right-side vectors. The problem data consists of an M by N matrix\n A, an M by NB matrix B, and an absolute tolerance parameter TAU\n whose usage is described below. The NB column vectors of B\n represent right-side vectors for NB distinct linear least squares\n problems. This set of problems can also be written as the matrix least\n squares problem A = B , where X is the N by NB solution matrix. Note that if B is the M by M identity matrix, then X will be the\n pseudo-inverse of A. This subroutine first transforms the augmented matrix (A B) to a\n matrix (R C) using premultiplying Householder transformations with\n column interchanges. All subdiagonal elements in the matrix R are\n zero and its diagonal elements satisfy abs(r(i,i))>=abs(r(i+1,i+1)),\n i = 1,...,l-1, where\n l = min(m,n). The subroutine will compute an integer, KRANK, equal to the number\n of diagonal terms of R that exceed TAU in magnitude. Then a\n solution of minimum Euclidean length is computed using the first\n KRANK rows of (R C). To be specific we suggest that the user consider an easily\n computable matrix norm, such as, the maximum of all column sums of\n magnitudes. Now if the relative uncertainty of B is EPS, (norm of uncertainty/\n norm of B), it is suggested that TAU be set approximately equal to\n EPS*(norm of A). References C. L. Lawson and R. J. Hanson, Solving Least Squares\n Problems, Prentice-Hall, Inc., 1974, Chapter 14. Revision history 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 901005 Replace usage of DDIFF with usage of D1MACH. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: a (mda,*) A(MDA,N) .\nThe array A( , ) initially contains the M by N\nmatrix A of the least squares problem AX = B.\nThe first dimensioning parameter of the array\nA( , ) is MDA, which must satisfy MDA>=M\nEither M>=N or M0\nthe array B( ) must initially contain the M by\nNB matrix B of the least squares problem AX =\nB. If NB>=2 the array B( ) must be doubly\nsubscripted with first dimensioning parameter\nMDB>=MAX(M,N). If NB = 1 the array B( ) may\nbe either doubly or singly subscripted. In\nthe latter case the value of MDB is arbitrary\nbut it should be set to some valid integer\nvalue such as MDB = M. The condition of NB>1.AND.MDB< MAX(M,N)\nis considered an error. On return the array B(*) will contain the N by\nNB solution matrix X. integer, intent(in) :: mdb actual leading dimension of b integer, intent(in) :: nb real(kind=wp), intent(in) :: tau Absolute tolerance parameter provided by user\nfor pseudorank determination. integer, intent(out) :: krank Set by the subroutine to indicate the\npseudorank of A. real(kind=wp), intent(out) :: rnorm (*) RNORM(NB) .\nOn return, RNORM(J) will contain the Euclidean\nnorm of the residual vector for the problem\ndefined by the J-th column vector of the array\nB( , ) for J = 1,...,NB. real(kind=wp) :: h (*) H(N) . Array of working space used by DHFTI.\nOn return, contains\nelements of the pre-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. real(kind=wp) :: g (*) G(N) . Array of working space used by DHFTI.\nOn return, contain\nelements of the post-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. integer :: ip (*) IP(N) . Array of working space used by DHFTI.\nArray in which the subroutine records indices\ndescribing the permutation of column vectors.\nnot generally required by the user. Calls proc~~dhfti~~CallsGraph proc~dhfti bspline_defc_module::dhfti proc~dh12 bspline_defc_module::dh12 proc~dhfti->proc~dh12 proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dhfti~~CalledByGraph proc~dhfti bspline_defc_module::dhfti proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dhfti proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dhfti ( a , mda , m , n , b , mdb , nb , tau , krank , rnorm , h , g , ip ) integer , intent ( in ) :: mda !! actual leading dimension of `a` integer , intent ( in ) :: mdb !! actual leading dimension of `b` real ( wp ), intent ( inout ) :: a ( mda , * ) !! `A(MDA,N)`. !! The array A(*,*) initially contains the M by N !! matrix A of the least squares problem AX = B. !! The first dimensioning parameter of the array !! A(*,*) is MDA, which must satisfy MDA>=M !! Either M>=N or M0 !! the array B(*) must initially contain the M by !! NB matrix B of the least squares problem AX = !! B. If NB>=2 the array B(*) must be doubly !! subscripted with first dimensioning parameter !! MDB>=MAX(M,N). If NB = 1 the array B(*) may !! be either doubly or singly subscripted. In !! the latter case the value of MDB is arbitrary !! but it should be set to some valid integer !! value such as MDB = M. !! !! The condition of NB>1.AND.MDB< MAX(M,N) !! is considered an error. !! !! On return the array B(*) will contain the N by !! NB solution matrix X. integer , intent ( in ) :: nb real ( wp ), intent ( in ) :: tau !! Absolute tolerance parameter provided by user !! for pseudorank determination. integer , intent ( out ) :: krank !! Set by the subroutine to indicate the !! pseudorank of A. real ( wp ), intent ( out ) :: rnorm ( * ) !! `RNORM(NB)`. !! On return, RNORM(J) will contain the Euclidean !! norm of the residual vector for the problem !! defined by the J-th column vector of the array !! B(*,*) for J = 1,...,NB. real ( wp ) :: h ( * ) !! `H(N)`. Array of working space used by DHFTI. !! On return, contains !! elements of the pre-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. real ( wp ) :: g ( * ) !! `G(N)`. Array of working space used by DHFTI. !! On return, contain !! elements of the post-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. integer :: ip ( * ) !! `IP(N)`. Array of working space used by DHFTI. !! Array in which the subroutine records indices !! describing the permutation of column vectors. !! not generally required by the user. integer :: i , ii , iopt , ip1 , j , jb , jj , k , kp1 , l , ldiag , lmax , nerr real ( wp ) :: dzero , factor , hmax , sm , sm1 , szero , tmp logical :: lmax_found szero = 0.0_wp dzero = 0.0_wp factor = 0.001_wp k = 0 ldiag = min ( m , n ) if ( ldiag > 0 ) then if ( mda < m ) then nerr = 1 iopt = 2 write ( * , * ) 'MDA 1 . and . max ( m , n ) > mdb ) then nerr = 2 iopt = 2 write ( * , * ) 'MDB1. PROBABLE ERROR.' return end if do j = 1 , ldiag lmax_found = . false . if ( j /= 1 ) then ! UPDATE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = h ( l ) - a ( j - 1 , l ) ** 2 if ( h ( l ) > h ( lmax )) lmax = l end do lmax_found = ( factor * h ( lmax ) > hmax * drelpr ) end if if (. not . lmax_found ) then ! COMPUTE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = 0.0_wp do i = j , m h ( l ) = h ( l ) + a ( i , l ) ** 2 end do if ( h ( l ) > h ( lmax )) lmax = l end do hmax = h ( lmax ) end if ! LMAX HAS BEEN DETERMINED ! DO COLUMN INTERCHANGES IF NEEDED. ip ( j ) = lmax if ( ip ( j ) /= j ) then do i = 1 , m tmp = a ( i , j ) a ( i , j ) = a ( i , lmax ) a ( i , lmax ) = tmp end do h ( lmax ) = h ( j ) end if ! COMPUTE THE J-TH TRANSFORMATION AND APPLY IT TO A ! AND B. call dh12 ( 1 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), a ( 1 , j + 1 ), 1 , mda , n - j ) call dh12 ( 2 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), b , 1 , mdb , nb ) end do ! DETERMINE THE PSEUDORANK, K, USING THE TOLERANCE, TAU. do j = 1 , ldiag if ( abs ( a ( j , j )) <= tau ) then k = j - 1 exit else if ( j == ldiag ) k = ldiag end if end do kp1 = k + 1 ! COMPUTE THE NORMS OF THE RESIDUAL VECTORS. if ( nb >= 1 ) then do jb = 1 , nb tmp = szero if ( m >= kp1 ) then do i = kp1 , m tmp = tmp + b ( i , jb ) ** 2 end do end if rnorm ( jb ) = sqrt ( tmp ) end do end if ! SPECIAL FOR PSEUDORANK = 0 if ( k > 0 ) then ! IF THE PSEUDORANK IS LESS THAN N COMPUTE HOUSEHOLDER ! DECOMPOSITION OF FIRST K ROWS. if ( k /= n ) then do ii = 1 , k i = kp1 - ii call dh12 ( 1 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), a , mda , 1 , i - 1 ) end do end if if ( nb >= 1 ) then do jb = 1 , nb ! SOLVE THE K BY K TRIANGULAR SYSTEM. do l = 1 , k sm = dzero i = kp1 - l ip1 = i + 1 if ( k >= ip1 ) then do j = ip1 , k sm = sm + a ( i , j ) * b ( j , jb ) end do end if sm1 = sm b ( i , jb ) = ( b ( i , jb ) - sm1 ) / a ( i , i ) end do ! COMPLETE COMPUTATION OF SOLUTION VECTOR. if ( k /= n ) then do j = kp1 , n b ( j , jb ) = szero end do do i = 1 , k call dh12 ( 2 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), b ( 1 , jb ), 1 , mdb , 1 ) end do end if ! RE-ORDER THE SOLUTION VECTOR TO COMPENSATE FOR THE ! COLUMN INTERCHANGES. do jj = 1 , ldiag j = ldiag + 1 - jj if ( ip ( j ) /= j ) then l = ip ( j ) tmp = b ( l , jb ) b ( l , jb ) = b ( j , jb ) b ( j , jb ) = tmp end if end do end do end if elseif ( nb >= 1 ) then do jb = 1 , nb do i = 1 , n b ( i , jb ) = szero end do end do end if end if ! THE SOLUTION VECTORS, X, ARE NOW ! IN THE FIRST N ROWS OF THE ARRAY B(,). krank = k end subroutine dhfti","tags":"","loc":"proc/dhfti.html"},{"title":"dlpdp – bspline-fortran","text":"private subroutine dlpdp(a, mda, m, n1, n2, prgopt, x, wnorm, mode, ws, is) Determine an N1-vector W, and\n an N2-vector Z\n which minimizes the Euclidean length of W\n subject to G W+H Z >= Y.\n This is the least projected distance problem, LPDP.\n The matrices G and H are of respective\n dimensions M by N1 and M by N2. Called by subprogram DLSI . The matrix\n (G H Y)\n\n occupies rows 1,...,M and cols 1,...,N1+N2+1 of A(*,*).\n\n The solution (W) is returned in X(*).\n (Z) Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 910408 Updated the AUTHOR section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: a (mda,*) A(MDA,N+1) , where N=N1+N2 . integer, intent(in) :: mda integer :: m integer, intent(in) :: n1 integer, intent(in) :: n2 real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) X(N) , where N=N1+N2 . real(kind=wp) :: wnorm integer, intent(out) :: mode The value of MODE indicates the status of\nthe computation after returning to the user. MODE=1 The solution was successfully obtained. MODE=2 The inequalities are inconsistent. real(kind=wp) :: ws (*) WS((M+2)*(N+7)) , where N=N1+N2 . This is a slight overestimate for WS(*). integer :: is (*) IS(M+N+1) , where N=N1+N2 . Calls proc~~dlpdp~~CallsGraph proc~dlpdp bspline_defc_module::dlpdp proc~dcopy bspline_blas_module::dcopy proc~dlpdp->proc~dcopy proc~ddot bspline_blas_module::ddot proc~dlpdp->proc~ddot proc~dnrm2 bspline_blas_module::dnrm2 proc~dlpdp->proc~dnrm2 proc~dscal bspline_blas_module::dscal proc~dlpdp->proc~dscal proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dscal proc~dasum bspline_blas_module::dasum proc~dwnlsm->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dwnlsm->proc~daxpy proc~dh12 bspline_defc_module::dh12 proc~dwnlsm->proc~dh12 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dswap bspline_blas_module::dswap proc~dwnlsm->proc~dswap proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dh12->proc~ddot proc~dh12->proc~daxpy proc~dh12->proc~dswap proc~dwnlit->proc~dcopy proc~dwnlit->proc~dscal proc~dwnlit->proc~dh12 proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~dswap proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dlpdp~~CalledByGraph proc~dlpdp bspline_defc_module::dlpdp proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dlpdp ( a , mda , m , n1 , n2 , prgopt , x , wnorm , mode , ws , is ) integer , intent ( in ) :: mda integer :: m integer , intent ( in ) :: n1 integer , intent ( in ) :: n2 real ( wp ) :: a ( mda , * ) !! `A(MDA,N+1)`, where `N=N1+N2`. real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) !! `X(N)`, where `N=N1+N2`. real ( wp ) :: wnorm integer , intent ( out ) :: mode !! The value of MODE indicates the status of !! the computation after returning to the user. !! !! * `MODE=1` The solution was successfully obtained. !! * `MODE=2` The inequalities are inconsistent. real ( wp ) :: ws ( * ) !! `WS((M+2)*(N+7))`, where `N=N1+N2`. This is a slight overestimate for WS(*). integer :: is ( * ) !! `IS(M+N+1)`, where `N=N1+N2`. integer :: i , iw , ix , j , l , modew , n , np1 real ( wp ) :: rnorm , sc , ynorm real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: fac = 0.1_wp n = n1 + n2 mode = 1 if ( m <= 0 ) then if ( n > 0 ) then x ( 1 ) = zero call dcopy ( n , x , 0 , x , 1 ) end if wnorm = zero return end if np1 = n + 1 ! SCALE NONZERO ROWS OF INEQUALITY MATRIX TO HAVE LENGTH ONE. do i = 1 , m sc = dnrm2 ( n , a ( i , 1 ), mda ) if ( sc /= zero ) then sc = one / sc call dscal ( np1 , sc , a ( i , 1 ), mda ) end if end do ! SCALE RT.-SIDE VECTOR TO HAVE LENGTH ONE (OR ZERO). ynorm = dnrm2 ( m , a ( 1 , np1 ), 1 ) if ( ynorm /= zero ) then sc = one / ynorm call dscal ( m , sc , a ( 1 , np1 ), 1 ) end if ! SCALE COLS OF MATRIX H. j = n1 + 1 do if ( j > n ) exit sc = dnrm2 ( m , a ( 1 , j ), 1 ) if ( sc /= zero ) sc = one / sc call dscal ( m , sc , a ( 1 , j ), 1 ) x ( j ) = sc j = j + 1 end do if ( n1 > 0 ) then ! COPY TRANSPOSE OF (H G Y) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m ! MOVE COL OF TRANSPOSE OF H INTO WORK ARRAY. call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ! MOVE COL OF TRANSPOSE OF G INTO WORK ARRAY. call dcopy ( n1 , a ( i , 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n1 ! MOVE COMPONENT OF VECTOR Y INTO WORK ARRAY. ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n ws ( iw + 1 ) = one iw = iw + 1 ! SOLVE EU=F SUBJECT TO (TRANSPOSE OF H)U=0, U>=0. THE ! MATRIX E = TRANSPOSE OF (G Y), AND THE (N+1)-VECTOR ! F = TRANSPOSE OF (0,...,0,1). ix = iw + 1 iw = iw + m ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , np1 , n2 , np1 - n2 , m , 0 , prgopt , ws ( ix ), rnorm , & modew , is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY W. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n1 x ( j ) = sc * ddot ( m , a ( 1 , j ), 1 , ws ( ix ), 1 ) end do ! COMPUTE THE VECTOR Q=Y-GW. OVERWRITE Y WITH THIS ! VECTOR. do i = 1 , m a ( i , np1 ) = a ( i , np1 ) - ddot ( n1 , a ( i , 1 ), mda , x , 1 ) end do end if if ( n2 > 0 ) then ! COPY TRANSPOSE OF (H Q) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n2 , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = one iw = iw + 1 ix = iw + 1 iw = iw + m ! SOLVE RV=S SUBJECT TO V>=0. THE MATRIX R =(TRANSPOSE ! OF (H Q)), WHERE Q=Y-GW. THE (N2+1)-VECTOR S =(TRANSPOSE ! OF (0,...,0,1)). ! ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , n2 + 1 , 0 , n2 + 1 , m , 0 , prgopt , ws ( ix ), rnorm , modew , & is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY Z. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n2 l = n1 + j x ( l ) = sc * ddot ( m , a ( 1 , l ), 1 , ws ( ix ), 1 ) * x ( l ) end do end if ! ACCOUNT FOR SCALING OF RT.-SIDE VECTOR IN SOLUTION. call dscal ( n , ynorm , x , 1 ) wnorm = dnrm2 ( n1 , x , 1 ) end subroutine dlpdp","tags":"","loc":"proc/dlpdp.html"},{"title":"dlsei – bspline-fortran","text":"private subroutine dlsei(w, mdw, me, ma, mg, n, prgopt, x, rnorme, rnorml, mode, ws, ip) This subprogram solves a linearly constrained least squares\n problem with both equality and inequality constraints, and, if the\n user requests, obtains a covariance matrix of the solution\n parameters. Suppose there are given matrices E, A and G of respective\n dimensions ME by N, MA by N and MG by N, and vectors F, B and H of\n respective lengths ME, MA and MG. This subroutine solves the\n linearly constrained least squares problem EX = F, (E ME by N) (equations to be exactly satisfied) AX = B, (A MA by N) (equations to be approximately satisfied, least squares sense) GX >= H,(G MG by N) (inequality constraints) The inequalities GX >= H mean that every component of the\n product GX must be >= the corresponding component of H. In case the equality constraints cannot be satisfied, a\n generalized inverse solution residual vector length is obtained\n for F-EX. This is the minimal length possible for F-EX. Any values ME >= 0, MA >= 0, or MG >= 0 are permitted. The\n rank of the matrix E is estimated during the computation. We call\n this value KRANKE. It is an output parameter in IP(1) defined\n below. Using a generalized inverse solution of EX=F, a reduced\n least squares problem with inequality constraints is obtained.\n The tolerances used in these tests for determining the rank\n of E and the rank of the reduced least squares problem are\n given in Sandia Tech. Rept. SAND-78-1290. They can be\n modified by the user if new values are provided in\n the option list of the array PRGOPT(*). The user must dimension all arrays appearing in the call list..\n W(MDW,N+1),PRGOPT( ),X(N),WS(2 (ME+N)+K+(MG+2) (N+7)),IP(MG+2 N+2)\n where K=MAX(MA+MG,N). This allows for a solution of a range of\n problems in the given working space. The dimension of WS(*)\n given is a necessary overestimate. Once a particular problem\n has been run, the output parameter IP(3) gives the actual\n dimension required for that problem. The parameters for DLSEI are Input .. All TYPE REAL variables are DOUBLE PRECISION W ( * , * ), MDW , The array W ( * , * ) is doubly subscripted with ME , MA , MG , N first dimensioning parameter equal to MDW . For this discussion let us call M = ME + MA + MG . Then MDW must satisfy MDW >= M . The condition MDW < M is an error . The array W ( * , * ) contains the matrices and vectors ( E F ) ( A B ) ( G H ) in rows and columns 1 ,..., M and 1 ,..., N + 1 respectively . The integers ME , MA , and MG are the respective matrix row dimensions of E , A and G . Each matrix has N columns . PRGOPT ( * ) This real - valued array is the option vector . If the user is satisfied with the nominal subprogram features set PRGOPT ( 1 ) = 1 ( or PRGOPT ( 1 ) = 1.0 ) Otherwise PRGOPT ( * ) is a linked list consisting of groups of data of the following form LINK KEY DATA SET The parameters LINK and KEY are each one word . The DATA SET can be comprised of several words . The number of items depends on the value of KEY . The value of LINK points to the first entry of the next group of data within PRGOPT ( * ). The exception is when there are no more options to change . In that case , LINK = 1 and the values KEY and DATA SET are not referenced . The general layout of PRGOPT ( * ) is as follows . ... PRGOPT ( 1 ) = LINK1 ( link to first entry of next group ) . PRGOPT ( 2 ) = KEY1 ( key to the option change ) . PRGOPT ( 3 ) = data value ( data value for this change ) . . . . . . ... PRGOPT ( LINK1 ) = LINK2 ( link to the first entry of . next group ) . PRGOPT ( LINK1 + 1 ) = KEY2 ( key to the option change ) . PRGOPT ( LINK1 + 2 ) = data value ... . . . . . ... PRGOPT ( LINK ) = 1 ( no more options to change ) Values of LINK that are nonpositive are errors . A value of LINK > NLINK = 100000 is also an error . This helps prevent using invalid but positive values of LINK that will probably extend beyond the program limits of PRGOPT ( * ). Unrecognized values of KEY are ignored . The order of the options is arbitrary and any number of options can be changed with the following restriction . To prevent cycling in the processing of the option array , a count of the number of options changed is maintained . Whenever this count exceeds NOPT = 1000 , an error message is printed and the subprogram returns . Options .. KEY = 1 Compute in W ( * , * ) the N by N covariance matrix of the solution variables as an output parameter . Nominally the covariance matrix will not be computed . ( This requires no user input .) The data set for this option is a single value . It must be nonzero when the covariance matrix is desired . If it is zero , the covariance matrix is not computed . When the covariance matrix is computed , the first dimensioning parameter of the array W ( * , * ) must satisfy MDW >= MAX ( M , N ). KEY = 10 Suppress scaling of the inverse of the normal matrix by the scale factor RNORM ** 2 / MAX ( 1 , no . of degrees of freedom ). This option only applies when the option for computing the covariance matrix ( KEY = 1 ) is used . With KEY = 1 and KEY = 10 used as options the unscaled inverse of the normal matrix is returned in W ( * , * ). The data set for this option is a single value . When it is nonzero no scaling is done . When it is zero scaling is done . The nominal case is to do scaling so if option ( KEY = 1 ) is used alone , the matrix will be scaled on output . KEY = 2 Scale the nonzero columns of the entire data matrix . ( E ) ( A ) ( G ) to have length one . The data set for this option is a single value . It must be nonzero if unit length column scaling is desired . KEY = 3 Scale columns of the entire data matrix ( E ) ( A ) ( G ) with a user - provided diagonal matrix . The data set for this option consists of the N diagonal scaling factors , one for each matrix column . KEY = 4 Change the rank determination tolerance for the equality constraint equations from the nominal value of SQRT ( DRELPR ). This quantity can be no smaller than DRELPR , the arithmetic - storage precision . The quantity DRELPR is the largest positive number such that T = 1. + DRELPR satisfies T == 1. The quantity used here is internally restricted to be at least DRELPR . The data set for this option is the new tolerance . KEY = 5 Change the rank determination tolerance for the reduced least squares equations from the nominal value of SQRT ( DRELPR ). This quantity can be no smaller than DRELPR , the arithmetic - storage precision . The quantity used here is internally restricted to be at least DRELPR . The data set for this option is the new tolerance . For example , suppose we want to change the tolerance for the reduced least squares problem , compute the covariance matrix of the solution parameters , and provide column scaling for the data matrix . For these options the dimension of PRGOPT ( * ) must be at least N + 9. The Fortran statements defining these options would be as follows : PRGOPT ( 1 ) = 4 ( link to entry 4 in PRGOPT ( * )) PRGOPT ( 2 ) = 1 ( covariance matrix key ) PRGOPT ( 3 ) = 1 ( covariance matrix wanted ) PRGOPT ( 4 ) = 7 ( link to entry 7 in PRGOPT ( * )) PRGOPT ( 5 ) = 5 ( least squares equas . tolerance key ) PRGOPT ( 6 ) = ... ( new value of the tolerance ) PRGOPT ( 7 ) = N + 9 ( link to entry N + 9 in PRGOPT ( * )) PRGOPT ( 8 ) = 3 ( user - provided column scaling key ) CALL DCOPY ( N , D , 1 , PRGOPT ( 9 ), 1 ) ( Copy the N scaling factors from the user array D ( * ) to PRGOPT ( 9 ) - PRGOPT ( N + 8 )) PRGOPT ( N + 9 ) = 1 ( no more options to change ) The contents of PRGOPT ( * ) are not modified by the subprogram . The options for WNNLS ( ) can also be included in this array . The values of KEY recognized by WNNLS ( ) are 6 , 7 and 8. Their functions are documented in the usage instructions for subroutine WNNLS ( ). Normally these options do not need to be modified when using [ [DLSEI ] ] . IP ( 1 ), The amounts of working storage actually IP ( 2 ) allocated for the working arrays WS ( * ) and IP ( * ), respectively . These quantities are compared with the actual amounts of storage needed by [ [DLSEI ] ] . Insufficient storage allocated for either WS ( * ) or IP ( * ) is an error . This feature was included in [ [DLSEI ] ] because miscalculating the storage formulas for WS ( * ) and IP ( * ) might very well lead to subtle and hard - to - find execution errors . The length of WS ( * ) must be at least LW = 2 * ( ME + N ) + K + ( MG + 2 ) * ( N + 7 ) where K = max ( MA + MG , N ) This test will not be made if IP ( 1 ) <= 0. The length of IP ( * ) must be at least LIP = MG + 2 * N + 2 This test will not be made if IP ( 2 ) <= 0. Output .. All TYPE REAL variables are DOUBLE PRECISION X ( * ), RNORME , The array X ( * ) contains the solution parameters RNORML if the integer output flag MODE = 0 or 1. The definition of MODE is given directly below . When MODE = 0 or 1 , RNORME and RNORML respectively contain the residual vector Euclidean lengths of F - EX and B - AX . When MODE = 1 the equality constraint equations EX = F are contradictory , so RNORME /= 0. The residual vector F - EX has minimal Euclidean length . For MODE >= 2 , none of these parameters is defined . MODE Integer flag that indicates the subprogram status after completion . If MODE >= 2 , no solution has been computed . MODE = 0 Both equality and inequality constraints are compatible and have been satisfied . 1 Equality constraints are contradictory . A generalized inverse solution of EX = F was used to minimize the residual vector length F - EX . In this sense , the solution is still meaningful . 2 Inequality constraints are contradictory . 3 Both equality and inequality constraints are contradictory . The following interpretation of MODE = 1 , 2 or 3 must be made . The sets consisting of all solutions of the equality constraints EX = F and all vectors satisfying GX >= H have no points in common . ( In particular this does not say that each individual set has no points at all , although this could be the case .) 4 Usage error occurred . The value of MDW is < ME + MA + MG , MDW is < N and a covariance matrix is requested , or the option vector PRGOPT ( * ) is not properly defined , or the lengths of the working arrays WS ( * ) and IP ( * ), when specified in IP ( 1 ) and IP ( 2 ) respectively , are not long enough . W ( * , * ) The array W ( * , * ) contains the N by N symmetric covariance matrix of the solution parameters , provided this was requested on input with the option vector PRGOPT ( * ) and the output flag is returned with MODE = 0 or 1. IP ( * ) The integer working array has three entries that provide rank and working array length information after completion . IP ( 1 ) = rank of equality constraint matrix . Define this quantity as KRANKE . IP ( 2 ) = rank of reduced least squares problem . IP ( 3 ) = the amount of storage in the working array WS ( * ) that was actually used by the subprogram . The formula given above for the length of WS ( * ) is a necessary overestimate . If exactly the same problem matrices are used in subsequent executions , the declared dimension of WS ( * ) can be reduced to this output value . User Designated Working Arrays .. WS ( * ), IP ( * ) These are respectively type real and type integer working arrays . Their required minimal lengths are given above . References K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Report SAND77-0552, Sandia\n Laboratories, June 1978. K. H. Haskell and R. J. Hanson, Selected algorithms for\n the linearly constrained least squares problem - a\n users guide, Report SAND78-1290, Sandia Laboratories,\n August 1979. K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Mathematical Programming\n 21 (1981), pp. 98-118. R. J. Hanson and K. H. Haskell, Two algorithms for the\n linearly constrained least squares problem, ACM\n Transactions on Mathematical Software, September 1982. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 890831 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900510 Convert XERRWV calls to XERMSG calls. (RWC) 900604 DP version created from SP version. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer, intent(in) :: mdw integer :: me integer :: ma integer :: mg integer :: n real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorme real(kind=wp) :: rnorml integer :: mode real(kind=wp) :: ws (*) integer :: ip (3) Calls proc~~dlsei~~CallsGraph proc~dlsei bspline_defc_module::dlsei proc~dasum bspline_blas_module::dasum proc~dlsei->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dlsei->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dlsei->proc~dcopy proc~ddot bspline_blas_module::ddot proc~dlsei->proc~ddot proc~dh12 bspline_defc_module::dh12 proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dnrm2 bspline_blas_module::dnrm2 proc~dlsei->proc~dnrm2 proc~dscal bspline_blas_module::dscal proc~dlsei->proc~dscal proc~dswap bspline_blas_module::dswap proc~dlsei->proc~dswap proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dlsi->proc~dasum proc~dlsi->proc~daxpy proc~dlsi->proc~dcopy proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dscal proc~dlsi->proc~dswap proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~ddot proc~dlpdp->proc~dnrm2 proc~dlpdp->proc~dscal proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~dasum proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dswap proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dlsei~~CalledByGraph proc~dlsei bspline_defc_module::dlsei proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dlsei ( w , mdw , me , ma , mg , n , prgopt , x , rnorme , & rnorml , mode , ws , ip ) integer , intent ( in ) :: mdw real ( wp ) :: w ( mdw , * ) integer :: me integer :: ma integer :: mg integer :: n real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) real ( wp ) :: rnorme real ( wp ) :: rnorml integer :: mode real ( wp ) :: ws ( * ) integer :: ip ( 3 ) real ( wp ) :: enorm , fnorm , gam , rb , rn , rnmax , size , & sn , snmax , t , tau , uj , up , vj , xnorm , xnrme integer :: i , imax , j , jp1 , k , key , kranke , last , lchk , link , m , & mapke1 , mdeqc , mend , mep1 , n1 , n2 , next , nlink , nopt , np1 , & ntimes logical :: cov , done character ( len = 8 ) :: xern1 , xern2 , xern3 , xern4 ! Set the nominal tolerance used in the code for the equality ! constraint equations. tau = sqrt ( drelpr ) ! Check that enough storage was allocated in WS(*) and IP(*). mode = 4 if ( min ( n , me , ma , mg ) < 0 ) then write ( xern1 , '(I8)' ) n write ( xern2 , '(I8)' ) me write ( xern3 , '(I8)' ) ma write ( xern4 , '(I8)' ) mg write ( * , * ) 'ALL OF THE VARIABLES N, ME,' // & ' MA, MG MUST BE >= 0. ENTERED ROUTINE WITH: ' // & 'N = ' // trim ( adjustl ( xern1 )) // & ', ME = ' // trim ( adjustl ( xern2 )) // & ', MA = ' // trim ( adjustl ( xern3 )) // & ', MG = ' // trim ( adjustl ( xern4 )) return endif if ( ip ( 1 ) > 0 ) then lchk = 2 * ( me + n ) + max ( ma + mg , n ) + ( mg + 2 ) * ( n + 7 ) if ( ip ( 1 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WS(*), NEED LW = ' // xern1 return endif endif if ( ip ( 2 ) > 0 ) then lchk = mg + 2 * n + 2 if ( ip ( 2 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IP(*), NEED LIP = ' // xern1 return endif endif ! Compute number of possible right multiplying Householder ! transformations. m = me + ma + mg if ( n <= 0 . or . m <= 0 ) then mode = 0 rnorme = 0 rnorml = 0 return endif if ( mdw < m ) then write ( * , * ) 'MDW < ME+MA+MG IS AN ERROR' return endif np1 = n + 1 kranke = min ( me , n ) n1 = 2 * kranke + 1 n2 = n1 + n ! Set nominal values. ! ! The nominal column scaling used in the code is ! the identity scaling. call dcopy ( n , [ 1.0_wp ], 0 , ws ( n1 ), 1 ) ! No covariance matrix is nominally computed. cov = . false . ! Process option vector. ! Define bound for number of options to change. nopt = 1000 ntimes = 0 ! Define bound for positive values of LINK. nlink = 100000 last = 1 link = prgopt ( 1 ) if ( link == 0 . or . link > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 1 ) then cov = prgopt ( last + 2 ) /= 0.0_wp elseif ( key == 2 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t ws ( j + n1 - 1 ) = t end do elseif ( key == 3 ) then call dcopy ( n , prgopt ( last + 2 ), 1 , ws ( n1 ), 1 ) elseif ( key == 4 ) then tau = max ( drelpr , prgopt ( last + 2 )) endif next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , ws ( n1 + j - 1 ), w ( 1 , j ), 1 ) end do if ( cov . and . mdw < n ) then write ( * , * ) 'MDW < N WHEN COV MATRIX NEEDED, IS AN ERROR' return endif ! Problem definition and option vector OK. mode = 0 ! Compute norm of equality constraint matrix and right side. enorm = 0.0_wp do j = 1 , n enorm = max ( enorm , dasum ( me , w ( 1 , j ), 1 )) end do fnorm = dasum ( me , w ( 1 , np1 ), 1 ) snmax = 0.0_wp rnmax = 0.0_wp do i = 1 , kranke ! Compute maximum ratio of vector lengths. Partition is at ! column I. do k = i , me sn = ddot ( n - i + 1 , w ( k , i ), mdw , w ( k , i ), mdw ) rn = ddot ( i - 1 , w ( k , 1 ), mdw , w ( k , 1 ), mdw ) if ( rn == 0.0_wp . and . sn > snmax ) then snmax = sn imax = k elseif ( k == i . or . sn * rnmax > rn * snmax ) then snmax = sn rnmax = rn imax = k endif end do ! Interchange rows if necessary. if ( i /= imax ) call dswap ( np1 , w ( i , 1 ), mdw , w ( imax , 1 ), mdw ) if ( snmax > rnmax * tau ** 2 ) then ! Eliminate elements I+1,...,N in row I. call dh12 ( 1 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), w ( i + 1 , 1 ), mdw , 1 , m - i ) else kranke = i - 1 exit endif end do ! Save diagonal terms of lower trapezoidal matrix. call dcopy ( kranke , w , mdw + 1 , ws ( kranke + 1 ), 1 ) ! Use Householder transformation from left to achieve ! KRANKE by KRANKE upper triangular form. if ( kranke < me ) then do k = kranke , 1 , - 1 ! Apply transformation to matrix cols. 1,...,K-1. call dh12 ( 1 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w , 1 , mdw , k - 1 ) ! Apply to rt side vector. call dh12 ( 2 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w ( 1 , np1 ), 1 , 1 , 1 ) end do endif ! Solve for variables 1,...,KRANKE in new coordinates. call dcopy ( kranke , w ( 1 , np1 ), 1 , x , 1 ) do i = 1 , kranke x ( i ) = ( x ( i ) - ddot ( i - 1 , w ( i , 1 ), mdw , x , 1 )) / w ( i , i ) end do ! Compute residuals for reduced problem. mep1 = me + 1 rnorml = 0.0_wp do i = mep1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( kranke , w ( i , 1 ), mdw , x , 1 ) sn = ddot ( kranke , w ( i , 1 ), mdw , w ( i , 1 ), mdw ) rn = ddot ( n - kranke , w ( i , kranke + 1 ), mdw , w ( i , kranke + 1 ), mdw ) if ( rn <= sn * tau ** 2 . and . kranke < n ) & call dcopy ( n - kranke , [ 0.0_wp ], 0 , w ( i , kranke + 1 ), mdw ) end do ! Compute equality constraint equations residual length. rnorme = dnrm2 ( me - kranke , w ( kranke + 1 , np1 ), 1 ) ! Move reduced problem data upward if KRANKE 0 ) then mdeqc = 0 xnrme = dasum ( kranke , w ( 1 , np1 ), 1 ) if ( rnorme > tau * ( enorm * xnrme + fnorm )) mdeqc = 1 mode = mode + mdeqc ! Check if solution to equality constraints satisfies inequality ! constraints when there are no degrees of freedom left. if ( kranke == n . and . mg > 0 ) then xnorm = dasum ( n , x , 1 ) mapke1 = ma + kranke + 1 mend = ma + kranke + mg do i = mapke1 , mend size = dasum ( n , w ( i , 1 ), mdw ) * xnorm + abs ( w ( i , np1 )) if ( w ( i , np1 ) > tau * size ) then mode = mode + 2 done = . true . exit endif end do endif endif if (. not . done ) then ! Replace diagonal terms of lower trapezoidal matrix. if ( kranke > 0 ) then call dcopy ( kranke , ws ( kranke + 1 ), 1 , w , mdw + 1 ) ! Reapply transformation to put solution in original coordinates. do i = kranke , 1 , - 1 call dh12 ( 2 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), x , 1 , 1 , 1 ) end do ! Compute covariance matrix of equality constrained problem. if ( cov ) then do j = min ( kranke , n - 1 ), 1 , - 1 rb = ws ( j ) * w ( j , j ) if ( rb /= 0.0_wp ) rb = 1.0_wp / rb jp1 = j + 1 do i = jp1 , n w ( i , j ) = rb * ddot ( n - j , w ( i , jp1 ), mdw , w ( j , jp1 ), mdw ) end do gam = 0.5_wp * rb * ddot ( n - j , w ( jp1 , j ), 1 , w ( j , jp1 ), mdw ) call daxpy ( n - j , gam , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) do i = jp1 , n do k = i , n w ( i , k ) = w ( i , k ) + w ( j , i ) * w ( k , j ) + w ( i , j ) * w ( j , k ) w ( k , i ) = w ( i , k ) end do end do uj = ws ( j ) vj = gam * uj w ( j , j ) = uj * vj + uj * vj do i = jp1 , n w ( j , i ) = uj * w ( i , j ) + vj * w ( j , i ) end do call dcopy ( n - j , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) end do endif endif ! Apply the scaling to the covariance matrix. if ( cov ) then do i = 1 , n call dscal ( n , ws ( i + n1 - 1 ), w ( i , 1 ), mdw ) call dscal ( n , ws ( i + n1 - 1 ), w ( 1 , i ), 1 ) end do endif end if ! Rescale solution vector. if ( mode <= 1 ) then do j = 1 , n x ( j ) = x ( j ) * ws ( n1 + j - 1 ) end do endif ip ( 1 ) = kranke ip ( 3 ) = ip ( 3 ) + 2 * kranke + n end subroutine dlsei","tags":"","loc":"proc/dlsei.html"},{"title":"dlsi – bspline-fortran","text":"private subroutine dlsi(w, mdw, ma, mg, n, prgopt, x, rnorm, mode, ws, ip) This is a companion subprogram to DLSEI . The documentation for DLSEI has complete usage instructions. Solve: AX = B, A MA by N (least squares equations) subject to: GX >= H , G MG by N ( inequality constraints ) Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 900604 DP version created from SP version. (RWC) 920422 Changed CALL to DHFTI to include variable MA. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) W(*,*) contains: (A B)\n (G H) in rows 1,...,MA+MG ,\n cols 1,...,N+1 . integer, intent(in) :: mdw contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: ma contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: mg contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: n contain (resp) var. dimension of W(*,*) , and matrix dimensions. real(kind=wp), intent(in) :: prgopt (*) Program option vector. real(kind=wp), intent(out) :: x (*) Solution vector(unless MODE=2) real(kind=wp), intent(out) :: rnorm length of AX-B. integer, intent(out) :: mode =0 Inequality constraints are compatible. =2 Inequality constraints contradictory. real(kind=wp) :: ws (*) Working storage of dimension K+N+(MG+2)*(N+7) ,\nwhere K=MAX(MA+MG,N) . integer :: ip (*) IP(MG+2*N+1) Integer working storage Calls proc~~dlsi~~CallsGraph proc~dlsi bspline_defc_module::dlsi proc~dasum bspline_blas_module::dasum proc~dlsi->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dlsi->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dlsi->proc~dcopy proc~ddot bspline_blas_module::ddot proc~dlsi->proc~ddot proc~dh12 bspline_defc_module::dh12 proc~dlsi->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dscal bspline_blas_module::dscal proc~dlsi->proc~dscal proc~dswap bspline_blas_module::dswap proc~dlsi->proc~dswap proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~ddot proc~dlpdp->proc~dscal proc~dnrm2 bspline_blas_module::dnrm2 proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~dasum proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dswap proc~dwnlsm->proc~dnrm2 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dlsi~~CalledByGraph proc~dlsi bspline_defc_module::dlsi proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dlsi ( w , mdw , ma , mg , n , prgopt , x , rnorm , mode , ws , ip ) integer , intent ( in ) :: mdw !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: ma !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: mg !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: n !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. real ( wp ) :: w ( mdw , * ) !! `W(*,*)` contains: !! !!``` !! (A B) !! (G H) !!``` !! !! in rows `1,...,MA+MG`, !! cols `1,...,N+1`. real ( wp ), intent ( in ) :: prgopt ( * ) !! Program option vector. real ( wp ), intent ( out ) :: x ( * ) !! Solution vector(unless MODE=2) real ( wp ), intent ( out ) :: rnorm !! length of AX-B. integer , intent ( out ) :: mode !! * `=0` Inequality constraints are compatible. !! * `=2` Inequality constraints contradictory. real ( wp ) :: ws ( * ) !! Working storage of dimension `K+N+(MG+2)*(N+7)`, !! where `K=MAX(MA+MG,N)`. integer :: ip ( * ) !! `IP(MG+2*N+1)` Integer working storage real ( wp ) :: anorm , fac , gam , rb , tau , tol , xnorm integer :: i , j , k , key , krank , krm1 , krp1 , l , last , link , m , map1 , & mdlpdp , minman , n1 , n2 , n3 , next , np1 logical :: cov , sclcov real ( wp ) :: rnorm_ ( 1 ) !! JW added for call to [[dhfti]] ! Set the nominal tolerance used in the code. tol = sqrt ( drelpr ) mode = 0 rnorm = 0.0_wp m = ma + mg np1 = n + 1 krank = 0 main : block if ( n <= 0 . or . m <= 0 ) exit main ! To process option vector. cov = . false . sclcov = . true . last = 1 link = prgopt ( 1 ) do if ( link <= 1 ) exit key = prgopt ( last + 1 ) if ( key == 1 ) cov = prgopt ( last + 2 ) /= 0.0_wp if ( key == 10 ) sclcov = prgopt ( last + 2 ) == 0.0_wp if ( key == 5 ) tol = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) last = link link = next end do ! Compute matrix norm of least squares equations. anorm = 0.0_wp do j = 1 , n anorm = max ( anorm , dasum ( ma , w ( 1 , j ), 1 )) end do ! Set tolerance for DHFTI( ) rank test. tau = tol * anorm ! Compute Householder orthogonal decomposition of matrix. call dcopy ( n , [ 0.0_wp ], 0 , ws , 1 ) call dcopy ( ma , w ( 1 , np1 ), 1 , ws , 1 ) k = max ( m , n ) minman = min ( ma , n ) n1 = k + 1 n2 = n1 + n rnorm_ ( 1 ) = rnorm ! JW call dhfti ( w , mdw , ma , n , ws , ma , 1 , tau , krank , rnorm_ , ws ( n2 ), & ws ( n1 ), ip ) rnorm = rnorm_ ( 1 ) ! JW fac = 1.0_wp gam = ma - krank if ( krank < ma . and . sclcov ) fac = rnorm ** 2 / gam ! Reduce to DLPDP and solve. map1 = ma + 1 ! Compute inequality rt-hand side for DLPDP. if ( ma < m ) then if ( minman > 0 ) then do i = map1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( n , w ( i , 1 ), mdw , ws , 1 ) end do ! Apply permutations to col. of inequality constraint matrix. do i = 1 , minman call dswap ( mg , w ( map1 , i ), 1 , w ( map1 , ip ( i )), 1 ) end do ! Apply Householder transformations to constraint matrix. if ( krank > 0 . and . krank < n ) then do i = krank , 1 , - 1 call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & w ( map1 , 1 ), mdw , 1 , mg ) end do endif ! Compute permuted inequality constraint matrix times r-inv. do i = map1 , m do j = 1 , krank w ( i , j ) = ( w ( i , j ) - ddot ( j - 1 , w ( 1 , j ), 1 , w ( i , 1 ), mdw )) / w ( j , j ) end do end do endif ! Solve the reduced problem with DLPDP algorithm, ! the least projected distance problem. call dlpdp ( w ( map1 , 1 ), mdw , mg , krank , n - krank , prgopt , x , & xnorm , mdlpdp , ws ( n2 ), ip ( n + 1 )) ! Compute solution in original coordinates. if ( mdlpdp == 1 ) then do i = krank , 1 , - 1 x ( i ) = ( x ( i ) - ddot ( krank - i , w ( i , i + 1 ), mdw , x ( i + 1 ), 1 )) / w ( i , i ) end do ! Apply Householder transformation to solution vector. if ( krank < n ) then do i = 1 , krank call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & x , 1 , 1 , 1 ) end do endif ! Repermute variables to their input order. if ( minman > 0 ) then do i = minman , 1 , - 1 call dswap ( 1 , x ( i ), 1 , x ( ip ( i )), 1 ) end do ! Variables are now in original coordinates. ! Add solution of unconstrained problem. do i = 1 , n x ( i ) = x ( i ) + ws ( i ) end do ! Compute the residual vector norm. rnorm = sqrt ( rnorm ** 2 + xnorm ** 2 ) endif else mode = 2 endif else call dcopy ( n , ws , 1 , x , 1 ) endif ! Compute covariance matrix based on the orthogonal decomposition ! from DHFTI( ). if (. not . cov . or . krank <= 0 ) exit main krm1 = krank - 1 krp1 = krank + 1 ! Copy diagonal terms to working array. call dcopy ( krank , w , mdw + 1 , ws ( n2 ), 1 ) ! Reciprocate diagonal terms. do j = 1 , krank w ( j , j ) = 1.0_wp / w ( j , j ) end do ! Invert the upper triangular QR factor on itself. if ( krank > 1 ) then do i = 1 , krm1 do j = i + 1 , krank w ( i , j ) = - ddot ( j - i , w ( i , i ), mdw , w ( i , j ), 1 ) * w ( j , j ) end do end do endif ! Compute the inverted factor times its transpose. do i = 1 , krank do j = i , krank w ( i , j ) = ddot ( krank + 1 - j , w ( i , j ), mdw , w ( j , j ), mdw ) end do end do ! Zero out lower trapezoidal part. ! Copy upper triangular to lower triangular part. if ( krank < n ) then do j = 1 , krank call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do do i = krp1 , n call dcopy ( i , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Apply right side transformations to lower triangle. n3 = n2 + krp1 do i = 1 , krank l = n1 + i k = n2 + i rb = ws ( l - 1 ) * ws ( k - 1 ) ! If RB>=0.0_wp, transformation can be regarded as zero. if ( rb < 0.0_wp ) then rb = 1.0_wp / rb ! Store unscaled rank one Householder update in work array. call dcopy ( n , [ 0.0_wp ], 0 , ws ( n3 ), 1 ) l = n1 + i k = n3 + i ws ( k - 1 ) = ws ( l - 1 ) do j = krp1 , n ws ( n3 + j - 1 ) = w ( i , j ) end do do j = 1 , n ws ( j ) = rb * ( ddot ( j - i , w ( j , i ), mdw , ws ( n3 + i - 1 ), 1 ) + & ddot ( n - j + 1 , w ( j , j ), 1 , ws ( n3 + j - 1 ), 1 )) end do l = n3 + i gam = 0.5_wp * rb * ddot ( n - i + 1 , ws ( l - 1 ), 1 , ws ( i ), 1 ) call daxpy ( n - i + 1 , gam , ws ( l - 1 ), 1 , ws ( i ), 1 ) do j = i , n do l = 1 , i - 1 w ( j , l ) = w ( j , l ) + ws ( n3 + j - 1 ) * ws ( l ) end do do l = i , j w ( j , l ) = w ( j , l ) + ws ( j ) * ws ( n3 + l - 1 ) + ws ( l ) * ws ( n3 + j - 1 ) end do end do endif end do ! Copy lower triangle to upper triangle to symmetrize the ! covariance matrix. do i = 1 , n call dcopy ( i , w ( i , 1 ), mdw , w ( 1 , i ), 1 ) end do endif ! Repermute rows and columns. do i = minman , 1 , - 1 k = ip ( i ) if ( i /= k ) then call dswap ( 1 , w ( i , i ), 1 , w ( k , k ), 1 ) call dswap ( i - 1 , w ( 1 , i ), 1 , w ( 1 , k ), 1 ) call dswap ( k - i - 1 , w ( i , i + 1 ), mdw , w ( i + 1 , k ), 1 ) call dswap ( n - k , w ( i , k + 1 ), mdw , w ( k , k + 1 ), mdw ) endif end do ! Put in normalized residual sum of squares scale factor ! and symmetrize the resulting covariance matrix. do j = 1 , n call dscal ( j , fac , w ( 1 , j ), 1 ) call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do end block main ip ( 1 ) = krank ip ( 2 ) = n + max ( m , n ) + ( mg + 2 ) * ( n + 7 ) end subroutine dlsi","tags":"","loc":"proc/dlsi.html"},{"title":"dwnlit – bspline-fortran","text":"private subroutine dwnlit(w, mdw, m, n, l, ipivot, itype, h, scale, rnorm, idope, dope, done) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. Note: The M by (N+1) matrix W( , ) contains the rt. hand side B as the (N+1) st col. Triangularize L1 by L1 subsystem, where L1=MIN(M,L) , with\n col interchanges. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and revised. (WRB & RWC) 890620 Revised to make WNLT1, WNLT2, and WNLT3 subroutines. (RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 900604 DP version created from SP version. . (RWC) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: m integer :: n integer :: l integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: rnorm integer :: idope (*) real(kind=wp) :: dope (*) logical :: done Calls proc~~dwnlit~~CallsGraph proc~dwnlit bspline_defc_module::dwnlit proc~dcopy bspline_blas_module::dcopy proc~dwnlit->proc~dcopy proc~dh12 bspline_defc_module::dh12 proc~dwnlit->proc~dh12 proc~drotm bspline_blas_module::drotm proc~dwnlit->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlit->proc~drotmg proc~dscal bspline_blas_module::dscal proc~dwnlit->proc~dscal proc~dswap bspline_blas_module::dswap proc~dwnlit->proc~dswap proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~idamax bspline_blas_module::idamax proc~dwnlit->proc~idamax proc~dh12->proc~dswap proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlit~~CalledByGraph proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , & rnorm , idope , dope , done ) integer :: idope ( * ), ipivot ( * ), itype ( * ), l , m , mdw , n real ( wp ) :: dope ( * ), h ( * ), rnorm , scale ( * ), w ( mdw , * ) logical :: done real ( wp ) :: alsq , amax , eanorm , factor , hbar , rn , sparam ( 5 ), & t , tau integer :: i , i1 , imax , ir , j , j1 , jj , jp , krank , l1 , lb , lend , me , & mend , niv , nsoln logical :: indep , recalc me = idope ( 1 ) nsoln = idope ( 2 ) l1 = idope ( 3 ) alsq = dope ( 1 ) eanorm = dope ( 2 ) tau = dope ( 3 ) lb = min ( m - 1 , l ) recalc = . true . rnorm = 0.0_wp krank = 0 ! We set FACTOR=1.0 so that the heavy weight ALAMDA will be ! included in the test for column independence. factor = 1.0_wp lend = l main : block do i = 1 , lb ! Set IR to point to the I-th row. ir = i mend = m call dwnlt1 ( i , lend , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) do ! Perform column interchange. ! Test independence of incoming column. if ( dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then ! Eliminate I-th column below diagonal using modified Givens ! transformations applied to (A B). ! ! When operating near the ME line, use the largest element ! above it as the pivot. do j = m , i + 1 , - 1 jp = j - 1 if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , i ) ** 2 do jp = j - 1 , i , - 1 t = scale ( jp ) * w ( jp , i ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( jp , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do exit else if ( lend > i ) then ! Column I is dependent. Swap with column LEND. ! Perform column interchange, ! and find column in remaining set with largest SS. call dwnlt3 ( i , lend , m , mdw , ipivot , h , w ) lend = lend - 1 imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) else krank = i - 1 exit main endif end do end do krank = l1 end block main if ( krank < me ) then factor = alsq do i = krank + 1 , me call dcopy ( l , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Determine the rank of the remaining equality constraint ! equations by eliminating within the block of constrained ! variables. Remove any redundant constraints. recalc = . true . lb = min ( l + me - krank , n ) do i = l + 1 , lb ir = krank + i - l lend = n mend = me call dwnlt1 ( i , lend , me , ir , mdw , recalc , imax , hbar , h , & scale , w ) ! Update col ss and find pivot col call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange ! Eliminate elements in the I-th col. do j = me , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do ! I=column being eliminated. ! Test independence of incoming column. ! Remove any redundant or dependent equality constraints. if (. not . dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then jj = ir do ir = jj , me call dcopy ( n , [ 0.0_wp ], 0 , w ( ir , 1 ), mdw ) rnorm = rnorm + ( scale ( ir ) * w ( ir , n + 1 ) / alsq ) * w ( ir , n + 1 ) w ( ir , n + 1 ) = 0.0_wp scale ( ir ) = 1.0_wp ! Reclassify the zeroed row as a least squares equation. itype ( ir ) = 1 end do ! Reduce ME to reflect any discovered dependent equality ! constraints. me = jj - 1 exit endif end do endif ! Try to determine the variables KRANK+1 through L1 from the ! least squares equations. Continue the triangularization with ! pivot element W(ME+1,I). if ( krank < l1 ) then recalc = . true . ! Set FACTOR=ALSQ to remove effect of heavy weight from ! test for column independence. factor = alsq do i = krank + 1 , l1 ! Set IR to point to the ME+1-st row. ir = me + 1 lend = l mend = m call dwnlt1 ( i , l , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange. ! Eliminate I-th column below the IR-th element. do j = m , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , sparam ) endif end do ! Test if new pivot element is near zero. ! If so, the column is dependent. ! Then check row norm test to be classified as independent. t = scale ( ir ) * w ( ir , i ) ** 2 indep = t > ( tau * eanorm ) ** 2 if ( indep ) then rn = 0.0_wp do i1 = ir , m do j1 = i + 1 , n rn = max ( rn , scale ( i1 ) * w ( i1 , j1 ) ** 2 ) end do end do indep = t > rn * tau ** 2 endif ! If independent, swap the IR-th and KRANK+1-th rows to ! maintain the triangular form. Update the rank indicator ! KRANK and the equality constraint pointer ME. if (. not . indep ) exit call dswap ( n + 1 , w ( krank + 1 , 1 ), mdw , w ( ir , 1 ), mdw ) call dswap ( 1 , scale ( krank + 1 ), 1 , scale ( ir ), 1 ) ! Reclassify the least square equation as an equality ! constraint and rescale it. itype ( ir ) = 0 t = sqrt ( scale ( krank + 1 )) call dscal ( n + 1 , t , w ( krank + 1 , 1 ), mdw ) scale ( krank + 1 ) = alsq me = me + 1 krank = krank + 1 end do endif ! If pseudorank is less than L, apply Householder transformation. ! from right. if ( krank < l ) then do j = krank , 1 , - 1 call dh12 ( 1 , j , krank + 1 , l , w ( j , 1 ), mdw , h ( j ), w , mdw , 1 , & j - 1 ) end do endif niv = krank + nsoln - l if ( l == n ) done = . true . ! End of initial triangularization. idope ( 1 ) = me idope ( 2 ) = krank idope ( 3 ) = niv end subroutine dwnlit","tags":"","loc":"proc/dwnlit.html"},{"title":"dwnlsm – bspline-fortran","text":"private subroutine dwnlsm(w, mdw, mme, ma, n, l, prgopt, x, rnorm, mode, ipivot, itype, wd, h, scale, z, temp, d) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. In addition to the parameters discussed in the prologue to\n subroutine DWNNLS , the following work arrays are used in\n subroutine DWNLSM (they are passed through the calling\n sequence from DWNNLS for purposes of variable dimensioning).\n Their contents will in general be of no interest to the user. IPIVOT ( * ) An array of length N . Upon completion it contains the pivoting information for the cols of W ( * , * ) . ITYPE ( * ) An array of length M which is used to keep track of the classification of the equations . ITYPE ( I ) = 0 denotes equation I as an equality constraint . ITYPE ( I ) = 1 denotes equation I as a least squares equation . WD ( * ) An array of length N . Upon completion it contains the dual solution vector . H ( * ) An array of length N . Upon completion it contains the pivot scalars of the Householder transformations performed in the case KRANK < L . SCALE ( * ) An array of length M which is used by the subroutine to store the diagonal matrix of weights . These are used to apply the modified Givens transformations . Z ( * ), TEMP ( * ) Working arrays of length N . D ( * ) An array of length N that contains the column scaling for the matrix ( E ) . ( A ) Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and revised. (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900328 Added TYPE section. (WRB) 900510 Fixed an error message. (RWC) 900604 DP version created from SP version. (RWC) 900911 Restriction on value of ALAMDA included. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: mme integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: wd (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: z (*) real(kind=wp) :: temp (*) real(kind=wp) :: d (*) Calls proc~~dwnlsm~~CallsGraph proc~dwnlsm bspline_defc_module::dwnlsm proc~dasum bspline_blas_module::dasum proc~dwnlsm->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dwnlsm->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dwnlsm->proc~dcopy proc~dh12 bspline_defc_module::dh12 proc~dwnlsm->proc~dh12 proc~dnrm2 bspline_blas_module::dnrm2 proc~dwnlsm->proc~dnrm2 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dscal bspline_blas_module::dscal proc~dwnlsm->proc~dscal proc~dswap bspline_blas_module::dswap proc~dwnlsm->proc~dswap proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dh12->proc~daxpy proc~dh12->proc~dswap proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlsm~~CalledByGraph proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlsm ( w , mdw , mme , ma , n , l , prgopt , x , rnorm , mode , & ipivot , itype , wd , h , scale , z , temp , d ) integer :: ipivot ( * ), itype ( * ), l , ma , mdw , mme , mode , n real ( wp ) :: d ( * ), h ( * ), prgopt ( * ), rnorm , scale ( * ), temp ( * ), & w ( mdw , * ), wd ( * ), x ( * ), z ( * ) real ( wp ) :: alamda , alpha , alsq , amax , blowup , bnorm , & dope ( 3 ), eanorm , fac , sm , sparam ( 5 ), t , tau , wmax , z2 , & zz integer :: i , idope ( 3 ), imax , isol , itemp , iter , itmax , iwmax , j , & jcon , jp , key , krank , l1 , last , link , m , me , next , niv , nlink , & nopt , nsoln , ntimes logical :: done , feasbl , hitcon , pos ! Set the nominal tolerance used in the code. tau = sqrt ( drelpr ) m = ma + mme me = mme mode = 2 ! To process option vector fac = 1.0e-4_wp ! Set the nominal blow up factor used in the code. blowup = tau ! The nominal column scaling used in the code is ! the identity scaling. call dcopy ( n , [ 1.0_wp ], 0 , d , 1 ) ! Define bound for number of options to change. nopt = 1000 ! Define bound for positive value of LINK. nlink = 100000 ntimes = 0 last = 1 link = prgopt ( 1 ) if ( link <= 0 . or . link > nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'IN DWNNLS, THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 6 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t d ( j ) = t end do endif if ( key == 7 ) call dcopy ( n , prgopt ( last + 2 ), 1 , d , 1 ) if ( key == 8 ) tau = max ( drelpr , prgopt ( last + 2 )) if ( key == 9 ) blowup = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , d ( j ), w ( 1 , j ), 1 ) end do ! Process option vector done = . false . iter = 0 itmax = 3 * ( n - l ) mode = 0 nsoln = l l1 = min ( m , l ) ! Compute scale factor to apply to equality constraint equations. do j = 1 , n wd ( j ) = dasum ( m , w ( 1 , j ), 1 ) end do imax = idamax ( n , wd , 1 ) eanorm = wd ( imax ) bnorm = dasum ( m , w ( 1 , n + 1 ), 1 ) alamda = eanorm / ( drelpr * fac ) ! On machines, such as the VAXes using D floating, with a very ! limited exponent range for double precision values, the previously ! computed value of ALAMDA may cause an overflow condition. ! Therefore, this code further limits the value of ALAMDA. alamda = min ( alamda , sqrt ( huge ( 1.0_wp ))) ! Define scaling diagonal matrix for modified Givens usage and ! classify equation types. alsq = alamda ** 2 do i = 1 , m ! When equation I is heavily weighted ITYPE(I)=0, ! else ITYPE(I)=1. if ( i <= me ) then t = alsq itemp = 0 else t = 1.0_wp itemp = 1 endif scale ( i ) = t itype ( i ) = itemp end do ! Set the solution vector X(*) to zero and the column interchange ! matrix to the identity. call dcopy ( n , [ 0.0_wp ], 0 , x , 1 ) do i = 1 , n ipivot ( i ) = i end do ! Perform initial triangularization in the submatrix ! corresponding to the unconstrained variables. ! Set first L components of dual vector to zero because ! these correspond to the unconstrained variables. call dcopy ( l , [ 0.0_wp ], 0 , wd , 1 ) ! The arrays IDOPE(*) and DOPE(*) are used to pass ! information to DWNLIT(). This was done to avoid ! a long calling sequence or the use of COMMON. idope ( 1 ) = me idope ( 2 ) = nsoln idope ( 3 ) = l1 dope ( 1 ) = alsq dope ( 2 ) = eanorm dope ( 3 ) = tau call dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , rnorm , & idope , dope , done ) me = idope ( 1 ) krank = idope ( 2 ) niv = idope ( 3 ) main : do ! Perform WNNLS algorithm using the following steps. ! ! Until(DONE) ! compute search direction and feasible point ! when (HITCON) add constraints ! else perform multiplier test and drop a constraint ! fin ! Compute-Final-Solution ! ! To compute search direction and feasible point, ! solve the triangular system of currently non-active ! variables and store the solution in Z(*). ! ! To solve system ! Copy right hand side into TEMP vector to use overwriting method. if ( done ) exit main isol = l + 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Increment iteration counter and check against maximum number ! of iterations. iter = iter + 1 if ( iter > itmax ) then mode = 1 done = . true . endif ! Check to see if any constraints have become active. ! If so, calculate an interpolation factor so that all ! active constraints are removed from the basis. alpha = 2.0_wp hitcon = . false . do j = l + 1 , nsoln zz = z ( j ) if ( zz <= 0.0_wp ) then t = x ( j ) / ( x ( j ) - zz ) if ( t < alpha ) then alpha = t jcon = j endif hitcon = . true . endif end do ! Compute search direction and feasible point if ( hitcon ) then ! To add constraints, use computed ALPHA to interpolate between ! last feasible solution X(*) and current unconstrained (and ! infeasible) solution Z(*). do j = l + 1 , nsoln x ( j ) = x ( j ) + alpha * ( z ( j ) - x ( j )) end do feasbl = . false . do ! Remove column JCON and shift columns JCON+1 through N to the ! left. Swap column JCON into the N th position. This achieves ! upper Hessenberg form for the nonactive constraints and ! leaves an upper Hessenberg matrix to retriangularize. do i = 1 , m t = w ( i , jcon ) call dcopy ( n - jcon , w ( i , jcon + 1 ), mdw , w ( i , jcon ), mdw ) w ( i , n ) = t end do ! Update permuted index vector to reflect this shift and swap. itemp = ipivot ( jcon ) do i = jcon , n - 1 ipivot ( i ) = ipivot ( i + 1 ) end do ipivot ( n ) = itemp ! Similarly permute X(*) vector. call dcopy ( n - jcon , x ( jcon + 1 ), 1 , x ( jcon ), 1 ) x ( n ) = 0.0_wp nsoln = nsoln - 1 niv = niv - 1 ! Retriangularize upper Hessenberg matrix after adding ! constraints. i = krank + jcon - l do j = jcon , nsoln if ( itype ( i ) == 0 . and . itype ( i + 1 ) == 0 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 1 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 0 ) then call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp ! Swapped row was formerly a pivot element, so it will ! be large enough to perform elimination. ! Zero IP1 to I in column J. if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 0 . and . itype ( i + 1 ) == 1 ) then if ( scale ( i ) * w ( i , j ) ** 2 / alsq > ( tau * eanorm ) ** 2 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), & w ( i + 1 , j ), sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp w ( i + 1 , j ) = 0.0_wp endif endif i = i + 1 end do ! See if the remaining coefficients in the solution set are ! feasible. They should be because of the way ALPHA was ! determined. If any are infeasible, it is due to roundoff ! error. Any that are non-positive will be set to zero and ! removed from the solution set. do jcon = l + 1 , nsoln if ( x ( jcon ) <= 0.0_wp ) then exit else if ( jcon == nsoln ) feasbl = . true . end if end do if ( feasbl ) exit end do else ! To perform multiplier test and drop a constraint. call dcopy ( nsoln , z , 1 , x , 1 ) if ( nsoln < n ) call dcopy ( n - nsoln , [ 0.0_wp ], 0 , x ( nsoln + 1 ), 1 ) ! Reclassify least squares equations as equalities as necessary. i = niv + 1 do if ( i > me ) exit if ( itype ( i ) == 0 ) then i = i + 1 else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( me , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( me ), 1 ) itemp = itype ( i ) itype ( i ) = itype ( me ) itype ( me ) = itemp me = me - 1 endif end do ! Form inner product vector WD(*) of dual coefficients. do j = nsoln + 1 , n sm = 0.0_wp do i = nsoln + 1 , m sm = sm + scale ( i ) * w ( i , j ) * w ( i , n + 1 ) end do wd ( j ) = sm end do do ! Find J such that WD(J)=WMAX is maximum. This determines ! that the incoming column J will reduce the residual vector ! and be positive. wmax = 0.0_wp iwmax = nsoln + 1 do j = nsoln + 1 , n if ( wd ( j ) > wmax ) then wmax = wd ( j ) iwmax = j endif end do if ( wmax <= 0.0_wp ) exit main ! Set dual coefficients to zero for incoming column. wd ( iwmax ) = 0.0_wp ! WMAX > 0.0_wp, so okay to move column IWMAX to solution set. ! Perform transformation to retriangularize, and test for near ! linear dependence. ! ! Swap column IWMAX into NSOLN-th position to maintain upper ! Hessenberg form of adjacent columns, and add new column to ! triangular decomposition. nsoln = nsoln + 1 niv = niv + 1 if ( nsoln /= iwmax ) then call dswap ( m , w ( 1 , nsoln ), 1 , w ( 1 , iwmax ), 1 ) wd ( iwmax ) = wd ( nsoln ) wd ( nsoln ) = 0.0_wp itemp = ipivot ( nsoln ) ipivot ( nsoln ) = ipivot ( iwmax ) ipivot ( iwmax ) = itemp endif ! Reduce column NSOLN so that the matrix of nonactive constraints ! variables is triangular. do j = m , niv + 1 , - 1 jp = j - 1 ! When operating near the ME line, test to see if the pivot ! element is near zero. If so, use the largest element above ! it as the pivot. This is to maintain the sharp interface ! between weighted and non-weighted rows in all cases. if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , nsoln ) ** 2 do jp = j - 1 , niv , - 1 t = scale ( jp ) * w ( jp , nsoln ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , nsoln ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , nsoln ), w ( j , nsoln ), sparam ) w ( j , nsoln ) = 0.0_wp call drotm ( n + 1 - nsoln , w ( jp , nsoln + 1 ), mdw , w ( j , nsoln + 1 ), mdw , sparam ) endif end do ! Solve for Z(NSOLN)=proposed new value for X(NSOLN). Test if ! this is nonpositive or too large. If this was true or if the ! pivot term was zero, reject the column as dependent. if ( w ( niv , nsoln ) /= 0.0_wp ) then isol = niv z2 = w ( isol , n + 1 ) / w ( isol , nsoln ) z ( nsoln ) = z2 pos = z2 > 0.0_wp if ( z2 * eanorm >= bnorm . and . pos ) then pos = . not . ( blowup * z2 * eanorm >= bnorm ) endif elseif ( niv <= me . and . w ( me + 1 , nsoln ) /= 0.0_wp ) then ! Try to add row ME+1 as an additional equality constraint. ! Check size of proposed new solution component. ! Reject it if it is too large. isol = me + 1 if ( pos ) then ! Swap rows ME+1 and NIV, and scale factors for these rows. call dswap ( n + 1 , w ( me + 1 , 1 ), mdw , w ( niv , 1 ), mdw ) call dswap ( 1 , scale ( me + 1 ), 1 , scale ( niv ), 1 ) itemp = itype ( me + 1 ) itype ( me + 1 ) = itype ( niv ) itype ( niv ) = itemp me = me + 1 endif else pos = . false . endif if (. not . pos ) then nsoln = nsoln - 1 niv = niv - 1 endif if ( pos . or . done ) exit end do endif end do main ! Else perform multiplier test and drop a constraint. To compute ! final solution. Solve system, store results in X(*). ! ! Copy right hand side into TEMP vector to use overwriting method. isol = 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Solve system. call dcopy ( nsoln , z , 1 , x , 1 ) ! Apply Householder transformations to X(*) if KRANKproc~idamax Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlt1~~CalledByGraph proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dwnlt1 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlt1 ( i , lend , mend , ir , mdw , recalc , imax , hbar , h , & scale , w ) integer :: i , imax , ir , lend , mdw , mend real ( wp ) :: h ( * ), hbar , scale ( * ), w ( mdw , * ) logical :: recalc integer :: j , k if ( ir /= 1 . and . (. not . recalc )) then ! Update column SS=sum of squares. do j = i , lend h ( j ) = h ( j ) - scale ( ir - 1 ) * w ( ir - 1 , j ) ** 2 end do ! Test for numerical accuracy. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 recalc = ( hbar + 1.e-3 * h ( imax )) == hbar endif ! If required, recalculate column SS, using rows IR through MEND. if ( recalc ) then do j = i , lend h ( j ) = 0.0_wp do k = ir , mend h ( j ) = h ( j ) + scale ( k ) * w ( k , j ) ** 2 end do end do ! Find column with largest SS. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) endif end subroutine dwnlt1","tags":"","loc":"proc/dwnlt1.html"},{"title":"dwnlt3 – bspline-fortran","text":"private subroutine dwnlt3(i, imax, m, mdw, ipivot, h, w) Perform column interchange.\n Exchange elements of permuted index vector and perform column\n interchanges. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890620 Code extracted from WNLIT and made a subroutine. (RWC)) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer, intent(in) :: i integer, intent(in) :: imax integer, intent(in) :: m integer, intent(in) :: mdw integer, intent(inout) :: ipivot (*) real(kind=wp), intent(inout) :: h (*) real(kind=wp), intent(inout) :: w (mdw,*) Calls proc~~dwnlt3~~CallsGraph proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dswap bspline_blas_module::dswap proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlt3~~CalledByGraph proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dwnlt3 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) integer , intent ( in ) :: i integer , intent ( in ) :: imax integer , intent ( inout ) :: ipivot ( * ) integer , intent ( in ) :: m integer , intent ( in ) :: mdw real ( wp ), intent ( inout ) :: h ( * ) real ( wp ), intent ( inout ) :: w ( mdw , * ) real ( wp ) :: t integer :: itemp if ( imax /= i ) then itemp = ipivot ( i ) ipivot ( i ) = ipivot ( imax ) ipivot ( imax ) = itemp call dswap ( m , w ( 1 , imax ), 1 , w ( 1 , i ), 1 ) t = h ( imax ) h ( imax ) = h ( i ) h ( i ) = t endif end subroutine dwnlt3","tags":"","loc":"proc/dwnlt3.html"},{"title":"dwnnls – bspline-fortran","text":"private subroutine dwnnls(w, mdw, me, ma, n, l, prgopt, x, rnorm, mode, iwork, work) This subprogram solves a linearly constrained least squares\n problem. Suppose there are given matrices E and A of\n respective dimensions ME by N and MA by N , and vectors F and B of respective lengths ME and MA . This subroutine\n solves the problem EX = F , (equations to be exactly satisfied) AX = B , (equations to be approximately satisfied, in the least squares sense) subject to components L+1,...,N nonnegative Any values ME>=0 , MA>=0 and 0<= L <=N are permitted. The problem is reposed as problem DWNNLS (WT*E)X = (WT*F)\n ( A) ( B), (least squares)\n subject to components L+1,...,N nonnegative. The subprogram chooses the heavy weight (or penalty parameter) WT . The parameters for DWNNLS are INPUT .. All TYPE REAL variables are DOUBLE PRECISION W ( * , * ), MDW , The array W ( * , * ) is double subscripted with first ME , MA , N , L dimensioning parameter equal to MDW . For this discussion let us call M = ME + MA . Then MDW must satisfy MDW >= M . The condition MDW < M is an error . The array W ( * , * ) contains the matrices and vectors ( E F ) ( A B ) in rows and columns 1 , ... , M and 1 , ... , N + 1 respectively . Columns 1 , ... , L correspond to unconstrained variables X ( 1 ), ... , X ( L ) . The remaining variables are constrained to be nonnegative . The condition L < 0 or L > N is an error . PRGOPT ( * ) This double precision array is the option vector . If the user is satisfied with the nominal subprogram features set PRGOPT ( 1 ) = 1 ( or PRGOPT ( 1 ) = 1.0 ) Otherwise PRGOPT ( * ) is a linked list consisting of groups of data of the following form LINK KEY DATA SET The parameters LINK and KEY are each one word . The DATA SET can be comprised of several words . The number of items depends on the value of KEY . The value of LINK points to the first entry of the next group of data within PRGOPT ( * ) . The exception is when there are no more options to change . In that case LINK = 1 and the values KEY and DATA SET are not referenced . The general layout of PRGOPT ( * ) is as follows . ... PRGOPT ( 1 ) = LINK1 ( link to first entry of next group ) . PRGOPT ( 2 ) = KEY1 ( key to the option change ) . PRGOPT ( 3 ) = DATA VALUE ( data value for this change ) . . . . . . ... PRGOPT ( LINK1 ) = LINK2 ( link to the first entry of . next group ) . PRGOPT ( LINK1 + 1 ) = KEY2 ( key to the option change ) . PRGOPT ( LINK1 + 2 ) = DATA VALUE ... . . . . . ... PRGOPT ( LINK ) = 1 ( no more options to change ) Values of LINK that are nonpositive are errors . A value of LINK > NLINK = 100000 is also an error . This helps prevent using invalid but positive values of LINK that will probably extend beyond the program limits of PRGOPT ( * ) . Unrecognized values of KEY are ignored . The order of the options is arbitrary and any number of options can be changed with the following restriction . To prevent cycling in the processing of the option array a count of the number of options changed is maintained . Whenever this count exceeds NOPT = 1000 an error message is printed and the subprogram returns . OPTIONS .. KEY = 6 Scale the nonzero columns of the entire data matrix ( E ) ( A ) to have length one . The DATA SET for this option is a single value . It must be nonzero if unit length column scaling is desired . KEY = 7 Scale columns of the entire data matrix ( E ) ( A ) with a user - provided diagonal matrix . The DATA SET for this option consists of the N diagonal scaling factors , one for each matrix column . KEY = 8 Change the rank determination tolerance from the nominal value of SQRT ( SRELPR ) . This quantity can be no smaller than SRELPR , The arithmetic - storage precision . The quantity used here is internally restricted to be at least SRELPR . The DATA SET for this option is the new tolerance . KEY = 9 Change the blow - up parameter from the nominal value of SQRT ( SRELPR ) . The reciprocal of this parameter is used in rejecting solution components as too large when a variable is first brought into the active set . Too large means that the proposed component times the reciprocal of the parameter is not less than the ratio of the norms of the right - side vector and the data matrix . This parameter can be no smaller than SRELPR , the arithmetic - storage precision . For example , suppose we want to provide a diagonal matrix to scale the problem matrix and change the tolerance used for determining linear dependence of dropped col vectors . For these options the dimensions of PRGOPT ( * ) must be at least N + 6. The FORTRAN statements defining these options would be as follows . PRGOPT ( 1 ) = N + 3 ( link to entry N + 3 in PRGOPT ( * )) PRGOPT ( 2 ) = 7 ( user - provided scaling key ) CALL DCOPY ( N , D , 1 , PRGOPT ( 3 ), 1 ) ( copy the N scaling factors from a user array called D ( * ) into PRGOPT ( 3 ) - PRGOPT ( N + 2 )) PRGOPT ( N + 3 ) = N + 6 ( link to entry N + 6 of PRGOPT ( * )) PRGOPT ( N + 4 ) = 8 ( linear dependence tolerance key ) PRGOPT ( N + 5 ) =... ( new value of the tolerance ) PRGOPT ( N + 6 ) = 1 ( no more options to change ) IWORK ( 1 ), The amounts of working storage actually allocated IWORK ( 2 ) for the working arrays WORK ( * ) and IWORK ( * ), respectively . These quantities are compared with the actual amounts of storage needed for DWNNLS ( ) . Insufficient storage allocated for either WORK ( * ) or IWORK ( * ) is considered an error . This feature was included in DWNNLS ( ) because miscalculating the storage formulas for WORK ( * ) and IWORK ( * ) might very well lead to subtle and hard - to - find execution errors . The length of WORK ( * ) must be at least LW = ME + MA + 5 * N This test will not be made if IWORK ( 1 ) <= 0. The length of IWORK ( * ) must be at least LIW = ME + MA + N This test will not be made if IWORK ( 2 ) <= 0. OUTPUT .. All TYPE REAL variables are DOUBLE PRECISION X ( * ) An array dimensioned at least N , which will contain the N components of the solution vector on output . RNORM The residual norm of the solution . The value of RNORM contains the residual vector length of the equality constraints and least squares equations . MODE The value of MODE indicates the success or failure of the subprogram . MODE = 0 Subprogram completed successfully . = 1 Max . number of iterations ( equal to 3 * ( N - L )) exceeded . Nearly all problems should complete in fewer than this number of iterations . An approximate solution and its corresponding residual vector length are in X ( * ) and RNORM . = 2 Usage error occurred . The offending condition is noted with the error processing subprogram , XERMSG ( ) . User - designated Working arrays .. WORK ( * ) A double precision working array of length at least M + 5 * N . IWORK ( * ) An integer - valued working array of length at least M + N . References K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Report SAND77-0552, Sandia\n Laboratories, June 1978. K. H. Haskell and R. J. Hanson, Selected algorithms for\n the linearly constrained least squares problem - a\n users guide, Report SAND78-1290, Sandia Laboratories,\n August 1979. K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Mathematical Programming\n 21 (1981), pp. 98-118. R. J. Hanson and K. H. Haskell, Two algorithms for the\n linearly constrained least squares problem, ACM\n Transactions on Mathematical Software, September 1982. C. L. Lawson and R. J. Hanson, Solving Least Squares\n Problems, Prentice-Hall, Inc., 1974. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and revised. (WRB & RWC) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900510 Convert XERRWV calls to XERMSG calls, change Prologue\n comments to agree with WNNLS. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: me integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: iwork (*) real(kind=wp) :: work (*) Calls proc~~dwnnls~~CallsGraph proc~dwnnls bspline_defc_module::dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dasum bspline_blas_module::dasum proc~dwnlsm->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dwnlsm->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dwnlsm->proc~dcopy proc~dh12 bspline_defc_module::dh12 proc~dwnlsm->proc~dh12 proc~dnrm2 bspline_blas_module::dnrm2 proc~dwnlsm->proc~dnrm2 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dscal bspline_blas_module::dscal proc~dwnlsm->proc~dscal proc~dswap bspline_blas_module::dswap proc~dwnlsm->proc~dswap proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dh12->proc~daxpy proc~dh12->proc~dswap proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnnls~~CalledByGraph proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnnls ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , & iwork , work ) integer :: iwork ( * ), l , l1 , l2 , l3 , l4 , l5 , liw , lw , ma , mdw , me , & mode , n real ( wp ) :: prgopt ( * ), rnorm , w ( mdw , * ), work ( * ), x ( * ) character ( len = 8 ) :: xern1 mode = 0 if ( ma + me <= 0 . or . n <= 0 ) return if ( iwork ( 1 ) > 0 ) then lw = me + ma + 5 * n if ( iwork ( 1 ) < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WORK(*), NEED LW = ' // xern1 mode = 2 return endif endif if ( iwork ( 2 ) > 0 ) then liw = me + ma + n if ( iwork ( 2 ) < liw ) then write ( xern1 , '(I8)' ) liw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IWORK(*), NEED LIW = ' // xern1 mode = 2 return endif endif if ( mdw < me + ma ) then write ( * , * ) 'THE VALUE MDW n ) then write ( * , * ) 'L>=0 .AND. L<=N IS REQUIRED' mode = 2 return endif ! THE PURPOSE OF THIS SUBROUTINE IS TO BREAK UP THE ARRAYS ! WORK(*) AND IWORK(*) INTO SEPARATE WORK ARRAYS ! REQUIRED BY THE MAIN SUBROUTINE DWNLSM( ). l1 = n + 1 l2 = l1 + n l3 = l2 + me + ma l4 = l3 + n l5 = l4 + n call dwnlsm ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , iwork , & iwork ( l1 ), work ( 1 ), work ( l1 ), work ( l2 ), work ( l3 ), & work ( l4 ), work ( l5 )) end subroutine dwnnls","tags":"","loc":"proc/dwnnls.html"},{"title":"check_value – bspline-fortran","text":"private pure function check_value(x, t, i, extrap) result(iflag) Checks if the value is withing the range of the knot vectors.\nThis is called by the various db*val routines. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x the value to check real(kind=wp), intent(in), dimension(:) :: t the knot vector integer(kind=ip), intent(in) :: i 1=x, 2=y, 3=z, 4=q, 5=r, 6=s logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value integer(kind=ip) returns 0 if value is OK, otherwise returns 600+i Called by proc~~check_value~~CalledByGraph proc~check_value bspline_sub_module::check_value proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~check_value proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~check_value proc~db2val bspline_sub_module::db2val proc~db2val->proc~check_value proc~db3val bspline_sub_module::db3val proc~db3val->proc~check_value proc~db4val bspline_sub_module::db4val proc~db4val->proc~check_value proc~db5val bspline_sub_module::db5val proc~db5val->proc~check_value proc~db6val bspline_sub_module::db6val proc~db6val->proc~check_value interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function check_value ( x , t , i , extrap ) result ( iflag ) implicit none integer ( ip ) :: iflag !! returns 0 if value is OK, otherwise returns `600+i` real ( wp ), intent ( in ) :: x !! the value to check integer ( ip ), intent ( in ) :: i !! 1=x, 2=y, 3=z, 4=q, 5=r, 6=s real ( wp ), dimension (:), intent ( in ) :: t !! the knot vector logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: allow_extrapolation !! if extrapolation is allowed if ( present ( extrap )) then allow_extrapolation = extrap else allow_extrapolation = . false . end if if ( allow_extrapolation ) then ! in this case all values are OK iflag = 0_ip else if ( x < t ( 1_ip ) . or . x > t ( size ( t , kind = ip ))) then iflag = 600_ip + i ! value out of bounds (601, 602, etc.) else iflag = 0_ip end if end if end function check_value","tags":"","loc":"proc/check_value.html"},{"title":"get_temp_x_for_extrap – bspline-fortran","text":"private pure function get_temp_x_for_extrap(x, tmin, tmax, extrap) result(xt) Returns the value of x to use for computing the interval\nin t , depending on if extrapolation is allowed or not. If extrapolation is allowed and x is < tmin or > tmax, then either tmin or tmax - 2.0_wp*spacing(tmax) is returned.\nOtherwise, x is returned. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x variable value real(kind=wp), intent(in) :: tmin first knot vector element for b-splines real(kind=wp), intent(in) :: tmax last knot vector element for b-splines logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value real(kind=wp) The value returned (it will either\nbe tmin , x , or tmax ) Called by proc~~get_temp_x_for_extrap~~CalledByGraph proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv bspline_sub_module::dintrv proc~dintrv->proc~get_temp_x_for_extrap proc~db2val bspline_sub_module::db2val proc~db2val->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~db3val bspline_sub_module::db3val proc~db3val->proc~dintrv proc~db3val->proc~dbvalu proc~db4val bspline_sub_module::db4val proc~db4val->proc~dintrv proc~db4val->proc~dbvalu proc~db5val bspline_sub_module::db5val proc~db5val->proc~dintrv proc~db5val->proc~dbvalu proc~db6val bspline_sub_module::db6val proc~db6val->proc~dintrv proc~db6val->proc~dbvalu proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dintrv proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dbsqad bspline_sub_module::dbsqad proc~dbsqad->proc~dintrv proc~dbsqad->proc~dbvalu proc~dbvalu->proc~dintrv proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~dbvalu proc~dbsgq8->proc~dbvalu proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function get_temp_x_for_extrap ( x , tmin , tmax , extrap ) result ( xt ) implicit none real ( wp ), intent ( in ) :: x !! variable value real ( wp ), intent ( in ) :: tmin !! first knot vector element for b-splines real ( wp ), intent ( in ) :: tmax !! last knot vector element for b-splines real ( wp ) :: xt !! The value returned (it will either !! be `tmin`, `x`, or `tmax`) logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: extrapolation_allowed !! if extrapolation is allowed if ( present ( extrap )) then extrapolation_allowed = extrap else extrapolation_allowed = . false . end if if ( extrapolation_allowed ) then if ( x < tmin ) then xt = tmin else if ( x > tmax ) then ! Put it just inside the upper bound. ! This is sort of a hack to get ! extrapolation to work. xt = tmax - 2.0_wp * spacing ( tmax ) else xt = x end if else xt = x end if end function get_temp_x_for_extrap","tags":"","loc":"proc/get_temp_x_for_extrap.html"},{"title":"get_status_message – bspline-fortran","text":"public pure function get_status_message(iflag) result(msg) Returns a message string associated with the status code. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iflag return code from one of the routines Return Value character(len=:), allocatable status message associated with the flag Called by proc~~get_status_message~~CalledByGraph proc~get_status_message bspline_sub_module::get_status_message proc~get_bspline_status_message bspline_oo_module::bspline_class%get_bspline_status_message proc~get_bspline_status_message->proc~get_status_message Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function get_status_message ( iflag ) result ( msg ) implicit none integer ( ip ), intent ( in ) :: iflag !! return code from one of the routines character ( len = :), allocatable :: msg !! status message associated with the flag character ( len = 10 ) :: istr !! for integer to string conversion integer ( ip ) :: istat !! for write statement select case ( iflag ) case ( 0_ip ); msg = 'Successful execution' case ( - 1_ip ); msg = 'Error in dintrv: x < xt(1_ip)' case ( - 2_ip ); msg = 'Error in dintrv: x >= xt(lxt)' case ( 1_ip ); msg = 'Error in evaluate_*d: class is not initialized' case ( 2_ip ); msg = 'Error in db*ink: iknot out of range' case ( 3_ip ); msg = 'Error in db*ink: nx out of range' case ( 4_ip ); msg = 'Error in db*ink: kx out of range' case ( 5_ip ); msg = 'Error in db*ink: x not strictly increasing' case ( 6_ip ); msg = 'Error in db*ink: tx not non-decreasing' case ( 7_ip ); msg = 'Error in db*ink: ny out of range' case ( 8_ip ); msg = 'Error in db*ink: ky out of range' case ( 9_ip ); msg = 'Error in db*ink: y not strictly increasing' case ( 10_ip ); msg = 'Error in db*ink: ty not non-decreasing' case ( 11_ip ); msg = 'Error in db*ink: nz out of range' case ( 12_ip ); msg = 'Error in db*ink: kz out of range' case ( 13_ip ); msg = 'Error in db*ink: z not strictly increasing' case ( 14_ip ); msg = 'Error in db*ink: tz not non-decreasing' case ( 15_ip ); msg = 'Error in db*ink: nq out of range' case ( 16_ip ); msg = 'Error in db*ink: kq out of range' case ( 17_ip ); msg = 'Error in db*ink: q not strictly increasing' case ( 18_ip ); msg = 'Error in db*ink: tq not non-decreasing' case ( 19_ip ); msg = 'Error in db*ink: nr out of range' case ( 20_ip ); msg = 'Error in db*ink: kr out of range' case ( 21_ip ); msg = 'Error in db*ink: r not strictly increasing' case ( 22_ip ); msg = 'Error in db*ink: tr not non-decreasing' case ( 23_ip ); msg = 'Error in db*ink: ns out of range' case ( 24_ip ); msg = 'Error in db*ink: ks out of range' case ( 25_ip ); msg = 'Error in db*ink: s not strictly increasing' case ( 26_ip ); msg = 'Error in db*ink: ts not non-decreasing' case ( 700_ip ); msg = 'Error in db*ink: size(x) /= size(fcn,1)' case ( 701_ip ); msg = 'Error in db*ink: size(y) /= size(fcn,2)' case ( 702_ip ); msg = 'Error in db*ink: size(z) /= size(fcn,3)' case ( 703_ip ); msg = 'Error in db*ink: size(q) /= size(fcn,4)' case ( 704_ip ); msg = 'Error in db*ink: size(r) /= size(fcn,5)' case ( 705_ip ); msg = 'Error in db*ink: size(s) /= size(fcn,6)' case ( 706_ip ); msg = 'Error in db*ink: size(x) /= nx' case ( 707_ip ); msg = 'Error in db*ink: size(y) /= ny' case ( 708_ip ); msg = 'Error in db*ink: size(z) /= nz' case ( 709_ip ); msg = 'Error in db*ink: size(q) /= nq' case ( 710_ip ); msg = 'Error in db*ink: size(r) /= nr' case ( 711_ip ); msg = 'Error in db*ink: size(s) /= ns' case ( 712_ip ); msg = 'Error in db*ink: size(tx) /= nx+kx' case ( 713_ip ); msg = 'Error in db*ink: size(ty) /= ny+ky' case ( 714_ip ); msg = 'Error in db*ink: size(tz) /= nz+kz' case ( 715_ip ); msg = 'Error in db*ink: size(tq) /= nq+kq' case ( 716_ip ); msg = 'Error in db*ink: size(tr) /= nr+kr' case ( 717_ip ); msg = 'Error in db*ink: size(ts) /= ns+ks' case ( 800_ip ); msg = 'Error in db*ink: size(x) /= size(bcoef,1)' case ( 801_ip ); msg = 'Error in db*ink: size(y) /= size(bcoef,2)' case ( 802_ip ); msg = 'Error in db*ink: size(z) /= size(bcoef,3)' case ( 803_ip ); msg = 'Error in db*ink: size(q) /= size(bcoef,4)' case ( 804_ip ); msg = 'Error in db*ink: size(r) /= size(bcoef,5)' case ( 805_ip ); msg = 'Error in db*ink: size(s) /= size(bcoef,6)' case ( 806_ip ); msg = 'Error in dbint4: currently, only k=4 can be used' case ( 100_ip ); msg = 'Error in dbintk: k does not satisfy k>=1' case ( 101_ip ); msg = 'Error in dbintk: n does not satisfy n>=k' case ( 102_ip ); msg = 'Error in dbintk: x(i) does not satisfy x(i)proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1ink_default~~CalledByGraph proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1ink_default ( x , nx , fcn , kx , iknot , tx , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant: !! !! * If `iknot=0` these are chosen by [[db1ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( out ) :: bcoef !! `(nx)` array of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)`. !! * 706 = `size(x)` \\ne `nx`. !! * 712 = `size(tx)` \\ne `nx+kx`. !! * 800 = `size(x)` \\ne `size(bcoef,1)`. logical :: status_ok real ( wp ), dimension (:), allocatable :: work !! work array of dimension `2*kx*(nx+1)` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) end if allocate ( work ( 2_ip * kx * ( nx + 1_ip ))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , 1_ip , tx , kx , bcoef , work , iflag ) deallocate ( work ) end if end subroutine db1ink_default","tags":"","loc":"proc/db1ink_default.html"},{"title":"db1ink_alt – bspline-fortran","text":"private pure subroutine db1ink_alt(x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: ibcl = 1 constrain the first derivative at x(1) to fbcl ibcl = 2 constrain the second derivative at x(1) to fbcl integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: ibcr = 1 constrain first derivative at x(nx) to fbcr ibcr = 2 constrain second derivative at x(nx) to fbcr real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: kntopt = 1 sets knot multiplicity at t(4) and t(nx+3) to 4 kntopt = 2 sets a symmetric placement of knots\n about t(4) and t(nx+3) real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 806: dbint4 can only be used when k=4 Calls proc~~db1ink_alt~~CallsGraph proc~db1ink_alt bspline_sub_module::db1ink_alt proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1ink_alt~~CalledByGraph proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1ink_alt ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , kntopt , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(nx+3)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(nx+3)` real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when `k=4` real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (n=nx+2) integer ( ip ) :: k !! order of spline (k=4) logical :: status_ok !! status flag for error checking real ( wp ), dimension ( 3 ), parameter :: tleft = 0.0_wp !! not used for this case (see [[dbint4]]) real ( wp ), dimension ( 3 ), parameter :: tright = 0.0_wp !! not used for this case (see [[dbint4]]) if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5_ip , nx + 2_ip )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt","tags":"","loc":"proc/db1ink_alt.html"},{"title":"db1ink_alt_2 – bspline-fortran","text":"private pure subroutine db1ink_alt_2(x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: ibcl = 1 constrain the first derivative at x(1) to fbcl ibcl = 2 constrain the second derivative at x(1) to fbcl integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: ibcr = 1 constrain first derivative at x(nx) to fbcr ibcr = 2 constrain second derivative at x(nx) to fbcr real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 806: dbint4 can only be used when k=4 Calls proc~~db1ink_alt_2~~CallsGraph proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt_2->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt_2->proc~dbint4 proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1ink_alt_2~~CalledByGraph proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1ink_alt_2 ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , tleft , tright , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! `t(1:3)` in increasing order supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! `t(nx+4:nx+6)` in increasing order supplied by the user. real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when k=4 real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (`n=nx+2`) integer ( ip ) :: k !! order of spline (`k=4`) logical :: status_ok !! status flag for error checking integer ( ip ), parameter :: kntopt = 3 !! use `tleft` and `tright` in [[dbint4]] if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5 , nx + 2 )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt_2","tags":"","loc":"proc/db1ink_alt_2.html"},{"title":"db1val_default – bspline-fortran","text":"private pure subroutine db1val_default(xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . To evaluate the interpolant itself, set idx=0 ,\n to evaluate the first partial with respect to x , set idx=1 , and so on. db1val returns 0.0 if ( xval , yval ) is out of range. that is, if xval < tx ( 1 ) . or . xval > tx ( nx + kx ) if the knots tx were chosen by db1ink , then this is equivalent to: xval < x ( 1 ) . or . xval > x ( nx ) + epsx where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) The input quantities tx , nx , kx , and bcoef should be\n unchanged since the last call of db1ink . History Jacob Williams, 10/30/2015 : Created 1D routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db1val_default~~CallsGraph proc~db1val_default bspline_sub_module::db1val_default proc~check_value bspline_sub_module::check_value proc~db1val_default->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_default->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1val_default~~CalledByGraph proc~db1val_default bspline_sub_module::db1val_default interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_default proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1val_default ( xval , idx , tx , nx , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db1ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db1ink]]) real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , nx , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_default","tags":"","loc":"proc/db1val_default.html"},{"title":"db1val_alt – bspline-fortran","text":"private pure subroutine db1val_alt(xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db1val_alt~~CallsGraph proc~db1val_alt bspline_sub_module::db1val_alt proc~check_value bspline_sub_module::check_value proc~db1val_alt->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1val_alt~~CalledByGraph proc~db1val_alt bspline_sub_module::db1val_alt interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1val_alt ( xval , idx , tx , nx , n , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. integer ( ip ), intent ( in ) :: n !! length of `bcoef`: `nx+2` integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), dimension ( n + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , n , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_alt","tags":"","loc":"proc/db1val_alt.html"},{"title":"db1sqad – bspline-fortran","text":"public pure subroutine db1sqad(tx, bcoef, nx, kx, x1, x2, f, iflag, w0) Computes the integral on (x1,x2) of a kx -th order b-spline.\n Orders kx as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. See also dbsqad -- the core routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(out) :: f integral of the b-spline over ( x1 , x2 ) integer(kind=ip), intent(out) :: iflag status flag: : no errors : error real(kind=wp), intent(inout), dimension(3*kx) :: w0 work array for dbsqad Calls proc~~db1sqad~~CallsGraph proc~db1sqad bspline_sub_module::db1sqad proc~dbsqad bspline_sub_module::dbsqad proc~db1sqad->proc~dbsqad proc~dbvalu bspline_sub_module::dbvalu proc~dbsqad->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbsqad->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1sqad~~CalledByGraph proc~db1sqad bspline_sub_module::db1sqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1sqad ( tx , bcoef , nx , kx , x1 , x2 , f , iflag , w0 ) implicit none integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `1 <= k <= 20` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( out ) :: f !! integral of the b-spline over (`x1`,`x2`) integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3 * kx ), intent ( inout ) :: w0 !! work array for [[dbsqad]] call dbsqad ( tx , bcoef , nx , kx , x1 , x2 , f , w0 , iflag ) end subroutine db1sqad","tags":"","loc":"proc/db1sqad.html"},{"title":"db1fqad – bspline-fortran","text":"public subroutine db1fqad(fun, tx, bcoef, nx, kx, idx, x1, x2, tol, f, iflag, w0) Computes the integral on (x1,x2) of a product of a\n function fun and the idx -th derivative of a kx -th order b-spline,\n using the b-representation (tx,bcoef,nx,kx) , with an adaptive\n 8-point Legendre-Gauss algorithm. (x1,x2) must be a subinterval of t(kx) <= x <= t(nx+1) . See also dbfqad -- the core routine. Note This one is not pure, because we are not enforcing\n that the user function fun be pure. Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work) real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, kx >= 1 integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: f integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: : no errors : error real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array for dbfqad Calls proc~~db1fqad~~CallsGraph proc~db1fqad bspline_sub_module::db1fqad proc~dbfqad bspline_sub_module::dbfqad proc~db1fqad->proc~dbfqad proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dintrv bspline_sub_module::dintrv proc~dbfqad->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap proc~dbvalu->proc~dintrv Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1fqad~~CalledByGraph proc~db1fqad bspline_sub_module::db1fqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine db1fqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) implicit none procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work)` integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `kx >= 1` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: f !! integral of `bf(x)` on `(x1,x2)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array for [[dbfqad]] call dbfqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) end subroutine db1fqad","tags":"","loc":"proc/db1fqad.html"},{"title":"db2ink – bspline-fortran","text":"public pure subroutine db2ink(x, nx, y, ny, fcn, kx, ky, iknot, tx, ty, bcoef, iflag) Determines the parameters of a function that interpolates\n the two-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db2val . The interpolating function is a piecewise polynomial function\n represented as a tensor product of one-dimensional b-splines. the\n form of this function is where the functions and are one-dimensional b-spline\n basis functions. the coefficients are chosen so that Note that for each fixed value of , is a piecewise\n polynomial function of alone, and for each fixed value of , is a piecewise polynomial function of alone. in one dimension\n a piecewise polynomial may be created by partitioning a given\n interval into subintervals and defining a distinct polynomial piece\n on each one. the points where adjacent subintervals meet are called\n knots. each of the functions and above is a piecewise\n polynomial. Users of db2ink choose the order (degree+1) of the polynomial\n pieces used to define the piecewise polynomial in each of the and directions ( kx and ky ). users also may define their own knot\n sequence in and separately ( tx and ty ). if iflag=0 , however, db2ink will choose sequences of knots that result in a piecewise\n polynomial interpolant with kx-2 continuous partial derivatives in and ky-2 continuous partial derivatives in . ( kx knots are taken\n near each endpoint in the direction, not-a-knot end conditions\n are used, and the remaining knots are placed at data points if kx is even or at midpoints between data points if kx is odd. the direction is treated similarly.) After a call to db2ink , all information necessary to define the\n interpolating function are contained in the parameters nx , ny , kx , ky , tx , ty , and bcoef . These quantities should not be altered until\n after the last call of the evaluation routine db2val . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: ny Number of abcissae real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db1ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db2ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db2ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:) :: bcoef (nx,ny) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 706 = size(x) nx 707 = size(y) ny 712 = size(tx) nx+kx 713 = size(ty) ny+ky 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) Calls proc~~db2ink~~CallsGraph proc~db2ink bspline_sub_module::db2ink proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db2ink~~CalledByGraph proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , tx , ty , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: ny !! Number of y abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:), intent ( out ) :: bcoef !! `(nx,ny)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1),2*ky*(ny+1))` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny ,& kx = kx , ky = ky ,& x = x , y = y ,& tx = tx , ty = ty ,& f2 = fcn ,& bcoef2 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) end if allocate ( temp ( nx * ny )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip )))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx , ty , ky , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db2ink","tags":"","loc":"proc/db2ink.html"},{"title":"db2val – bspline-fortran","text":"public pure subroutine db2val(xval, yval, idx, idy, tx, ty, nx, ny, kx, ky, bcoef, f, iflag, inbvx, inbvy, iloy, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db2ink or one of its\n derivatives at the point ( xval , yval ). To evaluate the interpolant\n itself, set idx=idy=0 , to evaluate the first partial with respect\n to x , set idx=1,idy=0 , and so on. db2val returns 0.0 if (xval,yval) is out of range. that is, if xval < tx ( 1 ) . or . xval > tx ( nx + kx ) . or . yval < ty ( 1 ) . or . yval > ty ( ny + ky ) if the knots tx and ty were chosen by db2ink , then this is equivalent to: xval < x ( 1 ) . or . xval > x ( nx ) + epsx . or . yval < y ( 1 ) . or . yval > y ( ny ) + epsy where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) epsy = 0.1 * ( y ( ny ) - y ( ny - 1 )) The input quantities tx , ty , nx , ny , kx , ky , and bcoef should be\n unchanged since the last call of db2ink . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise\npolynomial in the direction.\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(nx,ny) :: bcoef the b-spline coefficients computed by db2ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db2val~~CallsGraph proc~db2val bspline_sub_module::db2val proc~check_value bspline_sub_module::check_value proc~db2val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db2val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db2val~~CalledByGraph proc~db2val bspline_sub_module::db2val proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db2val ( xval , yval , idx , idy , tx , ty , nx , ny , kx , ky , bcoef , f , iflag , inbvx , inbvy , iloy , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db2ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise !! polynomial in the y direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( nx , ny ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db2ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: k , lefty , kcol f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return kcol = lefty - ky do k = 1_ip , ky kcol = kcol + 1_ip call dbvalu ( tx , bcoef (:, kcol ), nx , kx , idx , xval , inbvx , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return !error end do kcol = lefty - ky + 1_ip call dbvalu ( ty ( kcol :), w1 , ky , ky , idy , yval , inbvy , w0 , iflag , f , extrap ) end subroutine db2val","tags":"","loc":"proc/db2val.html"},{"title":"db3ink – bspline-fortran","text":"public pure subroutine db3ink(x, nx, y, ny, z, nz, fcn, kx, ky, kz, iknot, tx, ty, tz, bcoef, iflag) Determines the parameters of a function that interpolates\n the three-dimensional gridded data The interpolating function and\n its derivatives may subsequently be evaluated by the function db3val . The interpolating function is a piecewise polynomial function\n represented as a tensor product of one-dimensional b-splines. the\n form of this function is where the functions , , and are one-dimensional b-\n spline basis functions. the coefficients are chosen so that: Note that for fixed values of and is a piecewise\n polynomial function of alone, for fixed values of and is a piecewise polynomial function of alone, and for fixed\n values of and is a function of alone. in one\n dimension a piecewise polynomial may be created by partitioning a\n given interval into subintervals and defining a distinct polynomial\n piece on each one. the points where adjacent subintervals meet are\n called knots. each of the functions , , and above is a\n piecewise polynomial. Users of db3ink choose the order (degree+1) of the polynomial\n pieces used to define the piecewise polynomial in each of the , ,\n and directions ( kx , ky , and kz ). users also may define their own\n knot sequence in , , separately ( tx , ty , and tz ). if iflag=0 ,\n however, db3ink will choose sequences of knots that result in a\n piecewise polynomial interpolant with kx-2 continuous partial\n derivatives in , ky-2 continuous partial derivatives in , and kz-2 continuous partial derivatives in . ( kx knots are taken near\n each endpoint in , not-a-knot end conditions are used, and the\n remaining knots are placed at data points if kx is even or at\n midpoints between data points if kx is odd. the and directions\n are treated similarly.) After a call to db3ink , all information necessary to define the\n interpolating function are contained in the parameters nx , ny , nz , kx , ky , kz , tx , ty , tz , and bcoef . these quantities should not be\n altered until after the last call of the evaluation routine db3val . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should\ncontain the function value at the point ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db3ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db3ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db3ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db3ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:) :: bcoef (nx,ny,nz) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = ty not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 712 = size(tx) nx+kx 713 = size(ty) ny+ky 714 = size(tz) nz+kz 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) Calls proc~~db3ink~~CallsGraph proc~db3ink bspline_sub_module::db3ink proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db3ink~~CalledByGraph proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db3ink ( x , nx , y , ny , z , nz , fcn , kx , ky , kz , iknot , tx , ty , tz , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. `fcn(i,j,k)` should !! contain the function value at the point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db3ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `ty` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1))` integer ( ip ) :: i , j , k , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz ,& kx = kx , ky = ky , kz = kz ,& x = x , y = y , z = z ,& tx = tx , ty = ty , tz = tz ,& f3 = fcn ,& bcoef3 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) end if allocate ( temp ( nx * ny * nz )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp = reshape( fcn, [nx*ny*nz] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k ) end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny , tz , kz , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db3ink","tags":"","loc":"proc/db3ink.html"},{"title":"db3val – bspline-fortran","text":"public pure subroutine db3val(xval, yval, zval, idx, idy, idz, tx, ty, tz, nx, ny, nz, kx, ky, kz, bcoef, f, iflag, inbvx, inbvy, inbvz, iloy, iloz, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db3ink or one of its\n derivatives at the point ( xval , yval , zval ). To evaluate the\n interpolant itself, set idx=idy=idz=0 , to evaluate the first\n partial with respect to x , set idx=1 , idy=idz=0 , and so on. db3val returns 0.0 if ( xval , yval , zval ) is out of range. that is, xval < tx ( 1 ) . or . xval > tx ( nx + kx ) . or . yval < ty ( 1 ) . or . yval > ty ( ny + ky ) . or . zval < tz ( 1 ) . or . zval > tz ( nz + kz ) if the knots tx , ty , and tz were chosen by db3ink , then this is\n equivalent to xval < x ( 1 ) . or . xval > x ( nx ) + epsx . or . yval < y ( 1 ) . or . yval > y ( ny ) + epsy . or . zval < z ( 1 ) . or . zval > z ( nz ) + epsz where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) epsy = 0.1 * ( y ( ny ) - y ( ny - 1 )) epsz = 0.1 * ( z ( nz ) - z ( nz - 1 )) The input quantities tx , ty , tz , nx , ny , nz , kx , ky , kz , and bcoef should remain unchanged since the last call of db3ink . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nx,ny,nz) :: bcoef the b-spline coefficients computed by db3ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz) :: w2 work array real(kind=wp), intent(inout), dimension(kz) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db3val~~CallsGraph proc~db3val bspline_sub_module::db3val proc~check_value bspline_sub_module::check_value proc~db3val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db3val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db3val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db3val~~CalledByGraph proc~db3val bspline_sub_module::db3val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db3val ( xval , yval , zval , idx , idy , idz ,& tx , ty , tz ,& nx , ny , nz , kx , ky , kz , bcoef , f , iflag ,& inbvx , inbvy , inbvz , iloy , iloz , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nx , ny , nz ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db3ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kz ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , kcoly , kcolz , j , k f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz ), nx , kx , idx , xval , inbvx , w0 , iflag , w2 ( j , k ), extrap ) if ( iflag /= 0_ip ) return end do end do kcoly = lefty - ky + 1_ip do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w2 (:, k ), ky , ky , idy , yval , inbvy , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return end do kcolz = leftz - kz + 1_ip call dbvalu ( tz ( kcolz :), w1 , kz , kz , idz , zval , inbvz , w0 , iflag , f , extrap ) end subroutine db3val","tags":"","loc":"proc/db3val.html"},{"title":"db4ink – bspline-fortran","text":"public pure subroutine db4ink(x, nx, y, ny, z, nz, q, nq, fcn, kx, ky, kz, kq, iknot, tx, ty, tz, tq, bcoef, iflag) Determines the parameters of a function that interpolates\n the four-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db4val . See db3ink header for more details. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,q) should contain the function value at the\n point ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db4ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the x direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the y direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the z direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the q direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:,:) :: bcoef (nx,ny,nz,nq) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = tz not non-decreasing. 15 = nq out of range. 16 = kq out of range. 17 = q not strictly increasing. 18 = tq not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 703 = size(q) size(fcn,4) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 709 = size(q) nq 712 = size(tx ) nx+kx 713 = size(ty ) ny+ky 714 = size(tz ) nz+kz 715 = size(tq ) nq+kq 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) 803 = size(q) size(bcoef,4) Calls proc~~db4ink~~CallsGraph proc~db4ink bspline_sub_module::db4ink proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db4ink~~CalledByGraph proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& tx , ty , tz , tq ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,q)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db4ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 712 = `size(tx`) \\ne `nx+kx` !! * 713 = `size(ty`) \\ne `ny+ky` !! * 714 = `size(tz`) \\ne `nz+kz` !! * 715 = `size(tq`) \\ne `nq+kq` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of dimension `nx*ny*nz*nq` real ( wp ), dimension (:), allocatable :: work !! work array of dimension `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq ,& kx = kx , ky = ky , kz = kz , kq = kq ,& x = x , y = y , z = z , q = q ,& tx = tx , ty = ty , tz = tz , tq = tq ,& f4 = fcn ,& bcoef4 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) end if allocate ( temp ( nx * ny * nz * nq )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz , tq , kq , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db4ink","tags":"","loc":"proc/db4ink.html"},{"title":"db4val – bspline-fortran","text":"public pure subroutine db4val(xval, yval, zval, qval, idx, idy, idz, idq, tx, ty, tz, tq, nx, ny, nz, nq, kx, ky, kz, kq, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, iloy, iloz, iloq, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db4ink or one of its\n derivatives at the point ( xval , yval , zval , qval ). To evaluate the\n interpolant itself, set idx=idy=idz=idq=0 , to evaluate the first\n partial with respect to x , set idx=1,idy=idz=idq=0 , and so on. See db3val header for more information. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq) :: bcoef the b-spline coefficients computed by db4ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq) :: w3 work array real(kind=wp), intent(inout), dimension(kz,kq) :: w2 work array real(kind=wp), intent(inout), dimension(kq) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db4val~~CallsGraph proc~db4val bspline_sub_module::db4val proc~check_value bspline_sub_module::check_value proc~db4val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db4val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db4val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db4val~~CalledByGraph proc~db4val bspline_sub_module::db4val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& tx , ty , tz , tq ,& nx , ny , nz , nq ,& kx , ky , kz , kq ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq ,& iloy , iloz , iloq , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db4ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nx , ny , nz , nq ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db4ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kz , kq ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kq ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , & kcoly , kcolz , kcolq , j , k , q f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w3 ( j , k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! y -> z, q kcoly = lefty - ky + 1_ip do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w3 (:, k , q ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w2 ( k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do ! z -> q kcolz = leftz - kz + 1_ip do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w2 (:, q ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w1 ( q ), extrap ) if ( iflag /= 0_ip ) return end do ! q kcolq = leftq - kq + 1_ip call dbvalu ( tq ( kcolq :), w1 , kq , kq , idq , qval , inbvq , w0 , iflag , f , extrap ) end subroutine db4val","tags":"","loc":"proc/db4val.html"},{"title":"db5ink – bspline-fortran","text":"public pure subroutine db5ink(x, nx, y, ny, z, nz, q, nq, r, nr, fcn, kx, ky, kz, kq, kr, iknot, tx, ty, tz, tq, tr, bcoef, iflag) Determines the parameters of a function that interpolates\n the five-dimensional gridded data: for: The interpolating function and its derivatives may subsequently be evaluated\n by the function db5val . See db3ink header for more details. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,q,r) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db5ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = tz not non-decreasing. 15 = nq out of range. 16 = kq out of range. 17 = q not strictly increasing. 18 = tq not non-decreasing. 19 = nr out of range. 20 = kr out of range. 21 = r not strictly increasing. 22 = tr not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 703 = size(q) size(fcn,4) 704 = size(r) size(fcn,5) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 709 = size(q) nq 710 = size(r) nr 712 = size(tx) nx+kx 713 = size(ty) ny+ky 714 = size(tz) nz+kz 715 = size(tq) nq+kq 716 = size(tr) nr+kr 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) 803 = size(q) size(bcoef,4) 804 = size(r) size(bcoef,5) Calls proc~~db5ink~~CallsGraph proc~db5ink bspline_sub_module::db5ink proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db5ink~~CalledByGraph proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& tx , ty , tz , tq , tr ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,q,r)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db5ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 704 = `size(r)` \\ne `size(fcn,5)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 710 = `size(r)` \\ne `nr` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` !! * 804 = `size(r)` \\ne `size(bcoef,5)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz*nq*nr` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1),2*kr*(nr+1))` integer ( ip ) :: i , j , k , l , m , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr ,& x = x , y = y , z = z , q = q , r = r ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr ,& f5 = fcn ,& bcoef5 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) end if allocate ( temp ( nx * ny * nz * nq * nr )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ), 2_ip * kr * ( nr + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp(1:nx*ny*nz*nq*nr) = reshape( fcn, [nx*ny*nz*nq*nr] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do m = 1_ip , nr do l = 1_ip , nq do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k , l , m ) end do end do end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz * nq * nr , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz * nq * nr , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny * nq * nr , tz , kz , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , bcoef , nq , nx * ny * nz * nr , tq , kq , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , temp , nr , nx * ny * nz * nq , tr , kr , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db5ink","tags":"","loc":"proc/db5ink.html"},{"title":"db5val – bspline-fortran","text":"public pure subroutine db5val(xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, tx, ty, tz, tq, tr, nx, ny, nz, nq, nr, kx, ky, kz, kq, kr, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, iloy, iloz, iloq, ilor, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db5ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval ). To evaluate the\n interpolant itself, set idx=idy=idz=idq=idr=0 , to evaluate the first\n partial with respect to x , set idx=1,idy=idz=idq=idr=0, and so on. See db3val header for more information. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr) :: bcoef the b-spline coefficients computed by db5ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr) :: w4 work array real(kind=wp), intent(inout), dimension(kz,kq,kr) :: w3 work array real(kind=wp), intent(inout), dimension(kq,kr) :: w2 work array real(kind=wp), intent(inout), dimension(kr) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db5val~~CallsGraph proc~db5val bspline_sub_module::db5val proc~check_value bspline_sub_module::check_value proc~db5val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db5val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db5val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db5val~~CalledByGraph proc~db5val bspline_sub_module::db5val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& tx , ty , tz , tq , tr ,& nx , ny , nz , nq , nr ,& kx , ky , kz , kq , kr ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr ,& iloy , iloz , iloq , ilor ,& w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db5ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db5ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kz , kq , kr ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kq , kr ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kr ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , & kcoly , kcolz , kcolq , kcolr , j , k , q , r f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr ),& nx , kx , idx , xval , inbvx , w0 , iflag , w4 ( j , k , q , r ),& extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! y -> z, q, r kcoly = lefty - ky + 1_ip do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w4 (:, k , q , r ), ky , ky , idy , yval , inbvy ,& w0 , iflag , w3 ( k , q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! z -> q, r kcolz = leftz - kz + 1_ip do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w3 (:, q , r ), kz , kz , idz , zval , inbvz ,& w0 , iflag , w2 ( q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do ! q -> r kcolq = leftq - kq + 1_ip do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w2 (:, r ), kq , kq , idq , qval , inbvq ,& w0 , iflag , w1 ( r ), extrap ) if ( iflag /= 0_ip ) return end do ! r kcolr = leftr - kr + 1_ip call dbvalu ( tr ( kcolr :), w1 , kr , kr , idr , rval , inbvr , w0 , iflag , f , extrap ) end subroutine db5val","tags":"","loc":"proc/db5val.html"},{"title":"db6ink – bspline-fortran","text":"public pure subroutine db6ink(x, nx, y, ny, z, nz, q, nq, r, nr, s, ns, fcn, kx, ky, kz, kq, kr, ks, iknot, tx, ty, tz, tq, tr, ts, bcoef, iflag) Determines the parameters of a function that interpolates\n the six-dimensional gridded data: for: the interpolating function and its derivatives may subsequently be evaluated\n by the function db6val . See db3ink header for more details. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ns number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to\ninterpolate. fcn(i,j,k,q,r,s) should contain the\nfunction value at the point\n( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db6ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the\nspline interpolant. f iknot=0 these are chosen by db6ink . f iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ts The (ns+ks) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr,ns) matrix of coefficients of the\nb-spline interpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = tz not non-decreasing. 15 = nq out of range. 16 = kq out of range. 17 = q not strictly increasing. 18 = tq not non-decreasing. 19 = nr out of range. 20 = kr out of range. 21 = r not strictly increasing. 22 = tr not non-decreasing. 23 = ns out of range. 24 = ks out of range. 25 = s not strictly increasing. 26 = ts not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 703 = size(q) size(fcn,4) 704 = size(r) size(fcn,5) 705 = size(s) size(fcn,6) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 709 = size(q) nq 710 = size(r) nr 711 = size(s) ns 712 = size(tx) nx+kx 713 = size(ty) ny+ky 714 = size(tz) nz+kz 715 = size(tq) nq+kq 716 = size(tr) nr+kr 717 = size(ts) ns+ks 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) 803 = size(q) size(bcoef,4) 804 = size(r) size(bcoef,5) 805 = size(s) size(bcoef,6) Calls proc~~db6ink~~CallsGraph proc~db6ink bspline_sub_module::db6ink proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db6ink~~CalledByGraph proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& tx , ty , tz , tq , tr , ts ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ns !! number of s abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! the order of spline pieces in s !! ( 2 \\le k_s < n_s ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. !! must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to !! interpolate. `fcn(i,j,k,q,r,s)` should contain the !! function value at the point !! (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db6ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the !! spline interpolant. !! !! * f `iknot=0` these are chosen by [[db6ink]]. !! * f `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ts !! The `(ns+ks)` knots in the s direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr,ns)` matrix of coefficients of the !! b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 23 = `ns` out of range. !! * 24 = `ks` out of range. !! * 25 = `s` not strictly increasing. !! * 26 = `ts` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 703 = `size(q) ` \\ne `size(fcn,4)` !! * 704 = `size(r) ` \\ne `size(fcn,5)` !! * 705 = `size(s) ` \\ne `size(fcn,6)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 709 = `size(q) ` \\ne `nq` !! * 710 = `size(r) ` \\ne `nr` !! * 711 = `size(s) ` \\ne `ns` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 717 = `size(ts)` \\ne `ns+ks` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` !! * 803 = `size(q) ` \\ne `size(bcoef,4)` !! * 804 = `size(r) ` \\ne `size(bcoef,5)` !! * 805 = `size(s) ` \\ne `size(bcoef,6)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of size `nx*ny*nz*nq*nr*ns` real ( wp ), dimension (:), allocatable :: work !! work array of size `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1), !! 2*kr*(nr+1),2*ks*(ns+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr , ns = ns ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr , ks = ks ,& x = x , y = y , z = z , q = q , r = r , s = s ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr , ts = ts ,& f6 = fcn ,& bcoef6 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) call dbknot ( s , ns , ks , ts ) end if allocate ( temp ( nx * ny * nz * nq * nr * ns )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ),& 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ),& 2_ip * kr * ( nr + 1_ip ), 2_ip * ks * ( ns + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq * nr * ns , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq * nr * ns , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq * nr * ns , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz * nr * ns , tq , kq , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , bcoef , nr , nx * ny * nz * nq * ns , tr , kr , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( s , ns , temp , ns , nx * ny * nz * nq * nr , ts , ks , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db6ink","tags":"","loc":"proc/db6ink.html"},{"title":"db6val – bspline-fortran","text":"public pure subroutine db6val(xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, tx, ty, tz, tq, tr, ts, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, inbvs, iloy, iloz, iloq, ilor, ilos, w5, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db6ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval , sval ). To evaluate the\n interpolant itself, set idx=idy=idz=idq=idr=ids=0 , to evaluate the first\n partial with respect to x , set idx=1,idy=idz=idq=idr=ids=0 , and so on. See db3val header for more information. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ns+ks) :: ts sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ns the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ks order of polynomial pieces in .\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr,ns) :: bcoef the b-spline coefficients computed by db6ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvs initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilos initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr,ks) :: w5 work array real(kind=wp), intent(inout), dimension(kz,kq,kr,ks) :: w4 work array real(kind=wp), intent(inout), dimension(kq,kr,ks) :: w3 work array real(kind=wp), intent(inout), dimension(kr,ks) :: w2 work array real(kind=wp), intent(inout), dimension(ks) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr,ks)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db6val~~CallsGraph proc~db6val bspline_sub_module::db6val proc~check_value bspline_sub_module::check_value proc~db6val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db6val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db6val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db6val~~CalledByGraph proc~db6val bspline_sub_module::db6val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& tx , ty , tz , tq , tr , ts ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr , inbvs ,& iloy , iloz , iloq , ilor , ilos ,& w5 , w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ns !! the number of interpolation points in s. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ks !! order of polynomial pieces in s. !! (same as in last call to [[db6ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ns + ks ), intent ( in ) :: ts !! sequence of knots defining the piecewise polynomial !! in the s direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr , ns ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db6ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvs !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilos !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr , ks ), intent ( inout ) :: w5 !! work array real ( wp ), dimension ( kz , kq , kr , ks ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kq , kr , ks ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kr , ks ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( ks ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr , ks )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , lefts ,& kcoly , kcolz , kcolq , kcolr , kcols ,& j , k , q , r , s f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( sval , ts , 6_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ts , ns + ks , sval , ilos , lefts , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r, s kcols = lefts - ks do s = 1_ip , ks kcols = kcols + 1_ip kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr , kcols ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w5 ( j , k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do end do ! y -> z, q, r, s kcoly = lefty - ky + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w5 (:, k , q , r , s ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w4 ( k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! z -> q, r, s kcolz = leftz - kz + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w4 (:, q , r , s ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w3 ( q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! q -> r, s kcolq = leftq - kq + 1_ip do s = 1_ip , ks do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w3 (:, r , s ),& kq , kq , idq , qval , inbvq , w0 , iflag ,& w2 ( r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do ! r -> s kcolr = leftr - kr + 1_ip do s = 1_ip , ks call dbvalu ( tr ( kcolr :), w2 (:, s ),& kr , kr , idr , rval , inbvr , w0 , iflag ,& w1 ( s ), extrap ) if ( iflag /= 0_ip ) return end do ! s kcols = lefts - ks + 1_ip call dbvalu ( ts ( kcols :), w1 , ks , ks , ids , sval , inbvs , w0 , iflag , f , extrap ) end subroutine db6val","tags":"","loc":"proc/db6val.html"},{"title":"check_inputs – bspline-fortran","text":"private pure subroutine check_inputs(iknot, iflag, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, x, y, z, q, r, s, tx, ty, tz, tq, tr, ts, f1, f2, f3, f4, f5, f6, bcoef1, bcoef2, bcoef3, bcoef4, bcoef5, bcoef6, alt, status_ok) Check the validity of the inputs to the db*ink routines.\n Prints warning message if there is an error,\n and also sets iflag and status_ok. Supports up to 6D: x , y , z , q , r , s Notes The code is new, but the logic is based on the original\n logic in the CMLIB routines db2ink and db3ink . History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iknot = 0 if the INK routine is computing the knots. integer(kind=ip), intent(out) :: iflag integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: x real(kind=wp), intent(in), optional, dimension(:) :: y real(kind=wp), intent(in), optional, dimension(:) :: z real(kind=wp), intent(in), optional, dimension(:) :: q real(kind=wp), intent(in), optional, dimension(:) :: r real(kind=wp), intent(in), optional, dimension(:) :: s real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts real(kind=wp), intent(in), optional, dimension(:) :: f1 real(kind=wp), intent(in), optional, dimension(:,:) :: f2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: f3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: f4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: f5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: f6 real(kind=wp), intent(in), optional, dimension(:) :: bcoef1 real(kind=wp), intent(in), optional, dimension(:,:) :: bcoef2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: bcoef3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: bcoef4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: bcoef5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: bcoef6 logical, intent(in), optional :: alt using the alt routine where 1st or\n2nd deriv is fixed at endpoints\n[default is False] logical, intent(out) :: status_ok Called by proc~~check_inputs~~CalledByGraph proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~check_inputs proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~check_inputs proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~check_inputs proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~check_inputs proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~check_inputs proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~check_inputs proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~check_inputs interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine check_inputs ( iknot ,& iflag ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& x , y , z , q , r , s ,& tx , ty , tz , tq , tr , ts ,& f1 , f2 , f3 , f4 , f5 , f6 ,& bcoef1 , bcoef2 , bcoef3 , bcoef4 , bcoef5 , bcoef6 ,& alt ,& status_ok ) implicit none integer ( ip ), intent ( in ) :: iknot !! = 0 if the `INK` routine is computing the knots. integer ( ip ), intent ( out ) :: iflag integer ( ip ), intent ( in ), optional :: nx , ny , nz , nq , nr , ns integer ( ip ), intent ( in ), optional :: kx , ky , kz , kq , kr , ks real ( wp ), dimension (:), intent ( in ), optional :: x , y , z , q , r , s real ( wp ), dimension (:), intent ( in ), optional :: tx , ty , tz , tq , tr , ts real ( wp ), dimension (:), intent ( in ), optional :: f1 , bcoef1 real ( wp ), dimension (:,:), intent ( in ), optional :: f2 , bcoef2 real ( wp ), dimension (:,:,:), intent ( in ), optional :: f3 , bcoef3 real ( wp ), dimension (:,:,:,:), intent ( in ), optional :: f4 , bcoef4 real ( wp ), dimension (:,:,:,:,:), intent ( in ), optional :: f5 , bcoef5 real ( wp ), dimension (:,:,:,:,:,:), intent ( in ), optional :: f6 , bcoef6 logical , intent ( in ), optional :: alt !! using the alt routine where 1st or !! 2nd deriv is fixed at endpoints !! [default is False] logical , intent ( out ) :: status_ok logical :: error integer :: iex !! extra points for the alt case (in `t` and `bcoef`) !! [currently, only allowed for the 1D case & `k=4`] status_ok = . false . iex = 0_ip ! default if ( present ( alt )) then if ( alt ) iex = 2_ip ! for \"alt\" mode end if if (( iknot < 0_ip ) . or . ( iknot > 1_ip )) then iflag = 2_ip ! iknot is out of range else call check ( 'x' , nx , kx , x , tx ,[ 3_ip , 4_ip , 5_ip , 6_ip , 706_ip , 712_ip ], iflag , error , iex ); if ( error ) return call check ( 'y' , ny , ky , y , ty ,[ 7_ip , 8_ip , 9_ip , 10_ip , 707_ip , 713_ip ], iflag , error , iex ); if ( error ) return call check ( 'z' , nz , kz , z , tz ,[ 11_ip , 12_ip , 13_ip , 14_ip , 708_ip , 714_ip ], iflag , error , iex ); if ( error ) return call check ( 'q' , nq , kq , q , tq ,[ 15_ip , 16_ip , 17_ip , 18_ip , 709_ip , 715_ip ], iflag , error , iex ); if ( error ) return call check ( 'r' , nr , kr , r , tr ,[ 19_ip , 20_ip , 21_ip , 22_ip , 710_ip , 716_ip ], iflag , error , iex ); if ( error ) return call check ( 's' , ns , ks , s , ts ,[ 23_ip , 24_ip , 25_ip , 26_ip , 711_ip , 717_ip ], iflag , error , iex ); if ( error ) return if ( present ( x ) . and . present ( f1 ) . and . present ( bcoef1 )) then if ( size ( x , kind = ip ) /= size ( f1 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef1 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( f2 ) . and . present ( bcoef2 )) then if ( size ( x , kind = ip ) /= size ( f2 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f2 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef2 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef2 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( f3 ) . and . & present ( bcoef3 )) then if ( size ( x , kind = ip ) /= size ( f3 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f3 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f3 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef3 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef3 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef3 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( f4 ) . and . present ( bcoef4 )) then if ( size ( x , kind = ip ) /= size ( f4 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f4 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f4 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f4 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef4 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef4 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef4 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef4 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( f5 ) . and . present ( bcoef5 )) then if ( size ( x , kind = ip ) /= size ( f5 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f5 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f5 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f5 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f5 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef5 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef5 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef5 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef5 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef5 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( s ) . and . present ( f6 ) . and . present ( bcoef6 )) then if ( size ( x , kind = ip ) /= size ( f6 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f6 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f6 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f6 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f6 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( s , kind = ip ) /= size ( f6 , 6_ip , kind = ip )) then ; iflag = 705_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef6 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef6 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef6 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef6 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef6 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if if ( size ( s , kind = ip ) + iex /= size ( bcoef6 , 6_ip , kind = ip )) then ; iflag = 805_ip ; return ; end if end if status_ok = . true . iflag = 0_ip end if contains pure subroutine check ( s , n , k , x , t , ierrs , iflag , error , ik ) !! check `t`,`x`,`n`,`k` for validity implicit none character ( len = 1 ), intent ( in ) :: s !! coordinate string: 'x','y','z','q','r','s' integer ( ip ), intent ( in ), optional :: n !! size of `x` integer ( ip ), intent ( in ), optional :: k !! order real ( wp ), dimension (:), intent ( in ), optional :: x !! abcissae vector real ( wp ), dimension (:), intent ( in ), optional :: t !! knot vector `size(n+k)` integer ( ip ), dimension (:), intent ( in ) :: ierrs !! int error codes for `n`,`k`,`x`,`t`, !! `size(x)`,`size(t)` checks integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error !! true if there was an error integer , intent ( in ) :: ik !! add this value to k integer ( ip ), dimension ( 2 ) :: itmp !! temp integer array if ( present ( n ) . and . present ( k ) . and . present ( x ) . and . present ( t )) then itmp = [ ierrs ( 1_ip ), ierrs ( 5 )] call check_n ( 'n' // s , n , x , itmp , iflag , error ); if ( error ) return call check_k ( 'k' // s , k + ik , n , ierrs ( 2 ), iflag , error ); if ( error ) return call check_x ( s , n , x , ierrs ( 3 ), iflag , error ); if ( error ) return if ( iknot /= 0_ip ) then itmp = [ ierrs ( 4 ), ierrs ( 6 )] call check_t ( 't' // s , n , k + ik , t , itmp , iflag , error ); if ( error ) return end if end if end subroutine check pure subroutine check_n ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x !! abcissae vector integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [n<3 check, size(x)==n check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if ( n < 3_ip ) then iflag = ierr ( 1_ip ) error = . true . else if ( size ( x ) /= n ) then iflag = ierr ( 2 ) error = . true . else error = . false . end if end if end subroutine check_n pure subroutine check_k ( s , k , n , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: k integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if (( k < 2_ip ) . or . ( k >= n )) then iflag = ierr error = . true . else error = . false . end if end subroutine check_k pure subroutine check_x ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . do i = 2_ip , n if ( x ( i ) <= x ( i - 1_ip )) then iflag = ierr return end if end do error = . false . end subroutine check_x pure subroutine check_t ( s , n , k , t , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: t integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [non-decreasing check, size check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . if ( size ( t ) /= ( n + k )) then iflag = ierr ( 2 ) return end if if ( iex == 0_ip ) then ! don't do this for \"alt\" mode since they haven't been computed yet do i = 2_ip , n + k if ( t ( i ) < t ( i - 1_ip )) then iflag = ierr ( 1_ip ) return end if end do end if error = . false . end subroutine check_t end subroutine check_inputs","tags":"","loc":"proc/check_inputs.html"},{"title":"dbknot – bspline-fortran","text":"private pure subroutine dbknot(x, n, k, t) dbknot chooses a knot sequence for interpolation of order k at the\n data points x(i), i=1,..,n. the n+k knots are placed in the array\n t. k knots are placed at each endpoint and not-a-knot end\n conditions are used. the remaining knots are placed at data points\n if n is even and between data points if n is odd. the rightmost\n knot is shifted slightly to the right to insure proper interpolation\n at x(n) (see page 350 of the reference). History Jacob Williams, 2/24/2015 : Refactored this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(:) :: t Called by proc~~dbknot~~CalledByGraph proc~dbknot bspline_sub_module::dbknot proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbknot proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbknot proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbknot proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbknot proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbknot proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbknot interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbknot ( x , n , k , t ) implicit none integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension (:), intent ( out ) :: t integer ( ip ) :: i , j , ipj , npj , ip1 , jstrt real ( wp ) :: rnot !put k knots at each endpoint !(shift right endpoints slightly -- see pg 350 of reference) rnot = x ( n ) + 0.1_wp * ( x ( n ) - x ( n - 1_ip ) ) do j = 1_ip , k t ( j ) = x ( 1_ip ) npj = n + j t ( npj ) = rnot end do !distribute remaining knots if ( mod ( k , 2_ip ) == 1_ip ) then !case of odd k -- knots between data points i = ( k - 1_ip ) / 2_ip - k ip1 = i + 1_ip jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = 0.5_wp * ( x ( ipj ) + x ( ipj + 1_ip ) ) end do else !case of even k -- knots at data points i = ( k / 2_ip ) - k jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = x ( ipj ) end do end if end subroutine dbknot","tags":"","loc":"proc/dbknot.html"},{"title":"dbtpcf – bspline-fortran","text":"private pure subroutine dbtpcf(x, n, fcn, ldf, nf, t, k, bcoef, work, iflag) dbtpcf computes b-spline interpolation coefficients for nf sets\n of data stored in the columns of the array fcn. the b-spline\n coefficients are stored in the rows of bcoef however.\n each interpolation is based on the n abcissa stored in the\n array x, and the n+k knots stored in the array t. the order\n of each interpolation is k. History Jacob Williams, 2/24/2015 : Refactored this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x real(kind=wp), intent(in), dimension(ldf,nf) :: fcn integer(kind=ip), intent(in) :: ldf integer(kind=ip), intent(in) :: nf real(kind=wp), intent(in), dimension(:) :: t integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(nf,n) :: bcoef real(kind=wp), intent(out), dimension(*) :: work work array of size >= 2*k*(n+1) integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 301: n should be >0 Calls proc~~dbtpcf~~CallsGraph proc~dbtpcf bspline_sub_module::dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbtpcf~~CalledByGraph proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbtpcf ( x , n , fcn , ldf , nf , t , k , bcoef , work , iflag ) integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: nf integer ( ip ), intent ( in ) :: ldf integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension ( ldf , nf ), intent ( in ) :: fcn real ( wp ), dimension (:), intent ( in ) :: t real ( wp ), dimension ( nf , n ), intent ( out ) :: bcoef real ( wp ), dimension ( * ), intent ( out ) :: work !! work array of size >= `2*k*(n+1)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 301: n should be >0 integer ( ip ) :: i , j , m1 , m2 , iq , iw ! check for null input if ( nf > 0_ip ) then ! partition work array m1 = k - 1_ip m2 = m1 + k iq = 1_ip + n iw = iq + m2 * n + 1_ip ! compute b-spline coefficients ! first data set call dbintk ( x , fcn , t , n , k , work , work ( iq ), work ( iw ), iflag ) if ( iflag == 0_ip ) then do i = 1_ip , n bcoef ( 1_ip , i ) = work ( i ) end do ! all remaining data sets by back-substitution if ( nf == 1_ip ) return do j = 2_ip , nf do i = 1_ip , n work ( i ) = fcn ( i , j ) end do call dbnslv ( work ( iq ), m2 , n , m1 , m1 , work ) do i = 1_ip , n bcoef ( j , i ) = work ( i ) end do end do end if else !write(error_unit,'(A)') 'dbtpcf - n should be >0' iflag = 301_ip end if end subroutine dbtpcf","tags":"","loc":"proc/dbtpcf.html"},{"title":"dbintk – bspline-fortran","text":"private pure subroutine dbintk(x, y, t, n, k, bcoef, q, work, iflag) dbintk produces the b-spline coefficients, bcoef, of the\n b-spline of order k with knots t(i), i=1,...,n+k, which\n takes on the value y(i) at x(i), i=1,...,n. the spline or\n any of its derivatives can be evaluated by calls to dbvalu . the i-th equation of the linear system a*bcoef = b for the\n coefficients of the interpolant enforces interpolation at\n x(i), i=1,...,n. hence, b(i) = y(i), for all i, and a is\n a band matrix with 2k-1 bands if a is invertible. the matrix\n a is generated row by row and stored, diagonal by diagonal,\n in the rows of q, with the main diagonal going into row k.\n the banded system is then solved by a call to dbnfac (which\n constructs the triangular factorization for a and stores it\n again in q), followed by a call to dbnslv (which then\n obtains the solution bcoef by substitution). dbnfac does no\n pivoting, since the total positivity of the matrix a makes\n this unnecessary. the linear system to be solved is\n (theoretically) invertible if and only if\n t(i) < x(i) < t(i+k), for all i.\n equality is permitted on the left for i=1 and on the right\n for i=n when k knots are used at x(1) or x(n). otherwise,\n violation of this condition is certain to lead to an error. Error conditions improper input singular system of equations History splint written by carl de boor [5] dbintk author: amos, d. e., (snla) : date written 800901 revision date 820801 000330 modified array declarations. (jec) Jacob Williams, 5/10/2015 : converted to free-form Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(n) :: x vector of length n containing data point abscissa\nin strictly increasing order. real(kind=wp), intent(in), dimension(n) :: y corresponding vector of length n containing data\npoint ordinates. real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k\nsince t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) = x(n), this leaves only n-k knots (not\nnecessarily x(i) values) interior to (x(1),x(n)) integer(kind=ip), intent(in) :: n number of data points, n >= k integer(kind=ip), intent(in) :: k order of the spline, k >= 1 real(kind=wp), intent(out), dimension(n) :: bcoef a vector of length n containing the b-spline coefficients real(kind=wp), intent(out), dimension(*) :: q a work vector of length (2 k-1) n, containing\nthe triangular factorization of the coefficient\nmatrix of the linear system being solved. the\ncoefficients for the interpolant of an\nadditional data set (x(i),yy(i)), i=1,...,n\nwith the same abscissa can be obtained by loading\nyy into bcoef and then executing\ncall dbnslv(q,2k-1,n,k-1,k-1,bcoef) real(kind=wp), intent(out), dimension(*) :: work work vector of length 2*k integer(kind=ip), intent(out) :: iflag 0: no errors. 100: k does not satisfy k>=1. 101: n does not satisfy n>=k. 102: x(i) does not satisfy x(i)proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbintk~~CalledByGraph proc~dbintk bspline_sub_module::dbintk proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbintk ( x , y , t , n , k , bcoef , q , work , iflag ) implicit none integer ( ip ), intent ( in ) :: n !! number of data points, n >= k real ( wp ), dimension ( n ), intent ( in ) :: x !! vector of length n containing data point abscissa !! in strictly increasing order. real ( wp ), dimension ( n ), intent ( in ) :: y !! corresponding vector of length n containing data !! point ordinates. real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length n+k !! since t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) !! >= x(n), this leaves only n-k knots (not !! necessarily x(i) values) interior to (x(1),x(n)) integer ( ip ), intent ( in ) :: k !! order of the spline, k >= 1 real ( wp ), dimension ( n ), intent ( out ) :: bcoef !! a vector of length n containing the b-spline coefficients real ( wp ), dimension ( * ), intent ( out ) :: q !! a work vector of length (2*k-1)*n, containing !! the triangular factorization of the coefficient !! matrix of the linear system being solved. the !! coefficients for the interpolant of an !! additional data set (x(i),yy(i)), i=1,...,n !! with the same abscissa can be obtained by loading !! yy into bcoef and then executing !! call dbnslv(q,2k-1,n,k-1,k-1,bcoef) real ( wp ), dimension ( * ), intent ( out ) :: work !! work vector of length 2*k integer ( ip ), intent ( out ) :: iflag !! * 0: no errors. !! * 100: k does not satisfy k>=1. !! * 101: n does not satisfy n>=k. !! * 102: x(i) does not satisfy x(i)=1' iflag = 100_ip return end if if ( n < k ) then !write(error_unit,'(A)') 'dbintk - n does not satisfy n>=k' iflag = 101_ip return end if jj = n - 1_ip if ( jj /= 0_ip ) then do i = 1_ip , jj if ( x ( i ) >= x ( i + 1_ip )) then !write(error_unit,'(A)') 'dbintk - x(i) does not satisfy x(i)= ilp1mx ) exit end do if (. not . found ) then left = left - 1_ip if ( xi > t ( left + 1_ip )) then !write(error_unit,'(A)') 'dbintk - some abscissa was not in the support of the'//& ! ' corresponding basis function and the system is singular' iflag = 103_ip return end if end if ! the i-th equation enforces interpolation at xi, hence ! a(i,j) = b(j,k,t)(xi), all j. only the k entries with j = ! left-k+1,...,left actually might be nonzero. these k numbers ! are returned, in bcoef (used for temp.storage here), by the ! following call dbspvn ( t , k , k , 1_ip , xi , left , bcoef , work , iwork , iflag ) if ( iflag /= 0_ip ) return ! we therefore want bcoef(j) = b(left-k+j)(xi) to go into ! a(i,left-k+j), i.e., into q(i-(left+j)+2*k,(left+j)-k) since ! a(i+j,j) is to go into q(i+k,j), all i,j, if we consider q ! as a two-dim. array , with 2*k-1 rows (see comments in ! dbnfac). in the present program, we treat q as an equivalent ! one-dimensional array (because of fortran restrictions on ! dimension statements) . we therefore want bcoef(j) to go into ! entry ! i -(left+j) + 2*k + ((left+j) - k-1)*(2*k-1) ! = i-left+1 + (left -k)*(2*k-1) + (2*k-2)*j ! of q. jj = i - left + 1_ip + ( left - k ) * ( k + km1 ) do j = 1_ip , k jj = jj + kpkm2 q ( jj ) = bcoef ( j ) end do end do ! obtain factorization of a, stored again in q. call dbnfac ( q , k + km1 , n , km1 , km1 , iflag ) if ( iflag == 1 ) then !success ! solve a*bcoef = y by backsubstitution do i = 1_ip , n bcoef ( i ) = y ( i ) end do call dbnslv ( q , k + km1 , n , km1 , km1 , bcoef ) iflag = 0_ip else !failure !write(error_unit,'(A)') 'dbintk - the system of solver detects a singular system'//& ! ' although the theoretical conditions for a solution were satisfied' iflag = 104_ip end if end subroutine dbintk","tags":"","loc":"proc/dbintk.html"},{"title":"dbnfac – bspline-fortran","text":"private pure subroutine dbnfac(w, nroww, nrow, nbandl, nbandu, iflag) Returns in w the LU-factorization (without pivoting) of the banded\n matrix a of order nrow with (nbandl + 1 + nbandu) bands or diagonals\n in the work array w . gauss elimination without pivoting is used. the routine is\n intended for use with matrices a which do not require row inter-\n changes during factorization, especially for the totally\n positive matrices which occur in spline calculations.\n the routine should not be used for an arbitrary banded matrix. Work array Input w array of size ( nroww , nrow ) contains the interesting part of a banded matrix a , with the diagonals or bands of a stored in the rows of w , while columns of a correspond to columns of w . this is the storage mode used in linpack and results in efficient innermost loops . explicitly , a has nbandl bands below the diagonal + 1 ( main ) diagonal + nbandu bands above the diagonal and thus , with middle = nbandu + 1 , a ( i + j , j ) is in w ( i + middle , j ) for i =- nbandu ,..., nbandl j = 1 ,..., nrow . for example , the interesting entries of a ( 1 , 2 ) - banded matrix of order 9 would appear in the first 1 + 1 + 2 = 4 rows of w as follows . 13 24 35 46 57 68 79 12 23 34 45 56 67 78 89 11 22 33 44 55 66 77 88 99 21 32 43 54 65 76 87 98 all other entries of w not identified in this way with an en - try of a are never referenced . Output if iflag = 1, then\n w contains the lu-factorization of a into a unit lower triangu-\n lar matrix l and an upper triangular matrix u (both banded)\n and stored in customary fashion over the corresponding entries\n of a . this makes it possible to solve any particular linear\n system a*x = b for x by a\n call dbnslv ( w, nroww, nrow, nbandl, nbandu, b )\n with the solution x contained in b on return . if iflag = 2, then\n one of nrow-1, nbandl,nbandu failed to be nonnegative, or else\n one of the potential pivots was found to be zero indicating\n that a does not have an lu-factorization. this implies that\n a is singular in case it is totally positive . History banfac written by carl de boor [5] dbnfac from CMLIB [1] Jacob Williams, 5/10/2015 : converted to free-form Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout), dimension(nroww,nrow) :: w work array. See header for details. integer(kind=ip), intent(in) :: nroww row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer(kind=ip), intent(in) :: nrow matrix order integer(kind=ip), intent(in) :: nbandl number of bands of a below the main diagonal integer(kind=ip), intent(in) :: nbandu number of bands of a above the main diagonal integer(kind=ip), intent(out) :: iflag indicating success(=1) or failure (=2) Called by proc~~dbnfac~~CalledByGraph proc~dbnfac bspline_sub_module::dbnfac proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbnfac proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbnfac proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbnfac ( w , nroww , nrow , nbandl , nbandu , iflag ) integer ( ip ), intent ( in ) :: nroww !! row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer ( ip ), intent ( in ) :: nrow !! matrix order integer ( ip ), intent ( in ) :: nbandl !! number of bands of a below the main diagonal integer ( ip ), intent ( in ) :: nbandu !! number of bands of a above the main diagonal integer ( ip ), intent ( out ) :: iflag !! indicating success(=1) or failure (=2) real ( wp ), dimension ( nroww , nrow ), intent ( inout ) :: w !! work array. See header for details. integer ( ip ) :: i , ipk , j , jmax , k , kmax , middle , midmk , nrowm1 real ( wp ) :: factor , pivot iflag = 1_ip middle = nbandu + 1_ip ! w(middle,.) contains the main diagonal of a. nrowm1 = nrow - 1_ip if ( nrowm1 < 0_ip ) then iflag = 2_ip return else if ( nrowm1 == 0_ip ) then if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandl <= 0_ip ) then ! a is upper triangular. check that diagonal is nonzero . do i = 1_ip , nrowm1 if ( w ( middle , i ) == 0.0_wp ) then iflag = 2_ip return end if end do if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandu <= 0_ip ) then ! a is lower triangular. check that diagonal is nonzero and ! divide each column by its diagonal. do i = 1_ip , nrowm1 pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do end do return end if ! a is not just a triangular matrix. construct lu factorization do i = 1_ip , nrowm1 ! w(middle,i) is pivot for i-th step . pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if ! jmax is the number of (nonzero) entries in column i ! below the diagonal. jmax = min ( nbandl , nrow - i ) ! divide each entry in column i below diagonal by pivot. do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do ! kmax is the number of (nonzero) entries in row i to ! the right of the diagonal. kmax = min ( nbandu , nrow - i ) ! subtract a(i,i+k)*(i-th column) from (i+k)-th column ! (below row i). do k = 1_ip , kmax ipk = i + k midmk = middle - k factor = w ( midmk , ipk ) do j = 1_ip , jmax w ( midmk + j , ipk ) = w ( midmk + j , ipk ) - w ( middle + j , i ) * factor end do end do end do ! check the last diagonal entry. if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip end subroutine dbnfac","tags":"","loc":"proc/dbnfac.html"},{"title":"dbnslv – bspline-fortran","text":"private pure subroutine dbnslv(w, nroww, nrow, nbandl, nbandu, b) Companion routine to dbnfac . it returns the solution x of the\n linear system a*x = b in place of b, given the lu-factorization\n for a in the work array w from dbnfac. (with , as stored in w), the unit lower triangular system is solved for , and y stored in b. then the\n upper triangular system is solved for x. the calculations\n are so arranged that the innermost loops stay within columns. History banslv written by carl de boor [5] dbnslv from SLATEC library [1] Jacob Williams, 5/10/2015 : converted to free-form Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nroww,nrow) :: w describes the lu-factorization of a banded matrix a of\norder nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nroww describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nrow describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandl describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandu describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . real(kind=wp), intent(inout), dimension(nrow) :: b in : right side of the system to be solved out : the solution x, of order nrow Called by proc~~dbnslv~~CalledByGraph proc~dbnslv bspline_sub_module::dbnslv proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbnslv proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbnslv proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbnslv proc~dbtpcf->proc~dbintk proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbnslv ( w , nroww , nrow , nbandl , nbandu , b ) integer ( ip ), intent ( in ) :: nroww !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nrow !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandl !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandu !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. real ( wp ), dimension ( nroww , nrow ), intent ( in ) :: w !! describes the lu-factorization of a banded matrix a of !! order `nrow` as constructed in [[dbnfac]]. real ( wp ), dimension ( nrow ), intent ( inout ) :: b !! * **in**: right side of the system to be solved !! * **out**: the solution x, of order nrow integer ( ip ) :: i , j , jmax , middle , nrowm1 middle = nbandu + 1_ip if ( nrow /= 1_ip ) then nrowm1 = nrow - 1_ip if ( nbandl /= 0_ip ) then ! forward pass ! for i=1,2,...,nrow-1, subtract right side(i)*(i-th column of l) ! from right side (below i-th row). do i = 1_ip , nrowm1 jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax b ( i + j ) = b ( i + j ) - b ( i ) * w ( middle + j , i ) end do end do end if ! backward pass ! for i=nrow,nrow-1,...,1, divide right side(i) by i-th diagonal ! entry of u, then subtract right side(i)*(i-th column ! of u) from right side (above i-th row). if ( nbandu <= 0_ip ) then ! a is lower triangular. do i = 1_ip , nrow b ( i ) = b ( i ) / w ( 1_ip , i ) end do return end if i = nrow do b ( i ) = b ( i ) / w ( middle , i ) jmax = min ( nbandu , i - 1_ip ) do j = 1_ip , jmax b ( i - j ) = b ( i - j ) - b ( i ) * w ( middle - j , i ) end do i = i - 1_ip if ( i <= 1_ip ) exit end do end if b ( 1_ip ) = b ( 1_ip ) / w ( middle , 1_ip ) end subroutine dbnslv","tags":"","loc":"proc/dbnslv.html"},{"title":"dbspvn – bspline-fortran","text":"private pure subroutine dbspvn(t, jhigh, k, index, x, ileft, vnikx, work, iwork, iflag) Calculates the value of all (possibly) nonzero basis\n functions at x of order max(jhigh,(j+1)*(index-1)), where t(k)\n <= x <= t(n+1) and j=iwork is set inside the routine on\n the first call when index=1. ileft is such that t(ileft) <=\n x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag)\n produces the proper ileft. dbspvn calculates using the basic\n algorithm needed in dbspvd. if only basis functions are\n desired, setting jhigh=k and index=1 can be faster than\n calling dbspvd, but extra coding is required for derivatives\n (index=2) and dbspvd is set up for this purpose. left limiting values are set up as described in dbspvd. Error Conditions improper input History bsplvn written by carl de boor [5] dbspvn author: amos, d. e., (snla) : date written 800901 revision date 820801 000330 modified array declarations. (jec) Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities- k dimension t(ileft+jhigh) integer(kind=ip), intent(in) :: jhigh order of b-spline, 1 <= jhigh <= k integer(kind=ip), intent(in) :: k highest possible order integer(kind=ip), intent(in) :: index index = 1 gives basis functions of order jhigh = 2 denotes previous entry with work , iwork values saved for subsequent calls to\n dbspvn. real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) real(kind=wp), intent(out), dimension(k) :: vnikx vector of length k for spline values. real(kind=wp), intent(inout), dimension(*) :: work a work vector of length 2*k integer(kind=ip), intent(inout) :: iwork a work parameter. both work and iwork contain\ninformation necessary to continue for index = 2 .\nwhen index = 1 exclusively, these are scratch\nvariables and can be used for other purposes. integer(kind=ip), intent(out) :: iflag 0: no errors 201: k does not satisfy k>=1 202: jhigh does not satisfy 1<=jhigh<=k 203: index is not 1 or 2 204: x does not satisfy t(ileft)<=x<=t(ileft+1) Called by proc~~dbspvn~~CalledByGraph proc~dbspvn bspline_sub_module::dbspvn proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbspvn proc~dbspvd bspline_sub_module::dbspvd proc~dbspvd->proc~dbspvn proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbspvd proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbspvn ( t , jhigh , k , index , x , ileft , vnikx , work , iwork , iflag ) implicit none real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-`k` !! dimension `t(ileft+jhigh)` integer ( ip ), intent ( in ) :: jhigh !! order of b-spline, `1 <= jhigh <= k` integer ( ip ), intent ( in ) :: k !! highest possible order integer ( ip ), intent ( in ) :: index !! index = 1 gives basis functions of order `jhigh` !! = 2 denotes previous entry with `work`, `iwork` !! values saved for subsequent calls to !! dbspvn. real ( wp ), intent ( in ) :: x !! argument of basis functions, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that `t(ileft) <= x < t(ileft+1)` real ( wp ), dimension ( k ), intent ( out ) :: vnikx !! vector of length `k` for spline values. real ( wp ), dimension ( * ), intent ( inout ) :: work !! a work vector of length `2*k` integer ( ip ), intent ( inout ) :: iwork !! a work parameter. both `work` and `iwork` contain !! information necessary to continue for `index = 2`. !! when `index = 1` exclusively, these are scratch !! variables and can be used for other purposes. integer ( ip ), intent ( out ) :: iflag !! * 0: no errors !! * 201: `k` does not satisfy `k>=1` !! * 202: `jhigh` does not satisfy `1<=jhigh<=k` !! * 203: `index` is not 1 or 2 !! * 204: `x` does not satisfy `t(ileft)<=x<=t(ileft+1)` integer ( ip ) :: imjp1 , ipj , jp1 , jp1ml , l real ( wp ) :: vm , vmprev ! content of j, deltam, deltap is expected unchanged between calls. ! work(i) = deltap(i), ! work(k+i) = deltam(i), i = 1,k if ( k < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - k does not satisfy k>=1' iflag = 201_ip return end if if ( jhigh > k . or . jhigh < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - jhigh does not satisfy 1<=jhigh<=k' iflag = 202_ip return end if if ( index < 1_ip . or . index > 2_ip ) then !write(error_unit,'(A)') 'dbspvn - index is not 1 or 2' iflag = 203_ip return end if if ( x < t ( ileft ) . or . x > t ( ileft + 1_ip )) then !write(error_unit,'(A)') 'dbspvn - x does not satisfy t(ileft)<=x<=t(ileft+1)' iflag = 204_ip return end if iflag = 0_ip if ( index == 1_ip ) then iwork = 1_ip vnikx ( 1_ip ) = 1.0_wp if ( iwork >= jhigh ) return end if do ipj = ileft + iwork work ( iwork ) = t ( ipj ) - x imjp1 = ileft - iwork + 1_ip work ( k + iwork ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = iwork + 1_ip do l = 1_ip , iwork jp1ml = jp1 - l vm = vnikx ( l ) / ( work ( l ) + work ( k + jp1ml )) vnikx ( l ) = vm * work ( l ) + vmprev vmprev = vm * work ( k + jp1ml ) end do vnikx ( jp1 ) = vmprev iwork = jp1 if ( iwork >= jhigh ) exit end do end subroutine dbspvn","tags":"","loc":"proc/dbspvn.html"},{"title":"dbvalu – bspline-fortran","text":"private pure subroutine dbvalu(t, a, n, k, ideriv, x, inbv, work, iflag, val, extrap) Evaluates the b-representation ( t , a , n , k ) of a b-spline\n at x for the function value on ideriv=0 or any of its\n derivatives on ideriv=1,2,...,k-1 . right limiting values\n (right derivatives) are returned except at the right end\n point x=t(n+1) where left limiting values are computed. the\n spline is defined on t(k) x t(n+1) .\n dbvalu returns a fatal error message when x is outside of this\n interval. To compute left derivatives or left limiting values at a\n knot t(i) , replace n by i-1 and set x=t(i), i=k+1,n+1 . Error Conditions improper input History bvalue written by carl de boor [5] dbvalu author: amos, d. e., (snla) : date written 800901 revision date 820801 000330 modified array declarations. (jec) Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k real(kind=wp), intent(in), dimension(n) :: a b-spline coefficient vector of length n integer(kind=ip), intent(in) :: n number of b-spline coefficients.\n(sum of knot multiplicities- k ) integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: ideriv order of the derivative, 0 <= ideriv <= k-1 . ideriv = 0 returns the b-spline value real(kind=wp), intent(in) :: x argument, t(k) <= x <= t(n+1) integer(kind=ip), intent(inout) :: inbv an initialization parameter which must be set\nto 1 the first time dbvalu is called. inbv contains information for efficient processing\nafter the initial call and inbv must not\nbe changed by the user. distinct splines require\ndistinct inbv parameters. real(kind=wp), intent(inout), dimension(:) :: work work vector of length at least 3*k integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 401: k does not satisfy k 1 402: n does not satisfy n k 403: ideriv does not satisfy 0 ideriv k 404: x is not greater than or equal to t(k) 405: x is not less than or equal to t(n+1) 406: a left limiting value cannot be obtained at t(k) real(kind=wp), intent(out) :: val the interpolated value logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~dbvalu~~CallsGraph proc~dbvalu bspline_sub_module::dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbvalu~~CalledByGraph proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~dbvalu proc~db2val bspline_sub_module::db2val proc~db2val->proc~dbvalu proc~db3val bspline_sub_module::db3val proc~db3val->proc~dbvalu proc~db4val bspline_sub_module::db4val proc~db4val->proc~dbvalu proc~db5val bspline_sub_module::db5val proc~db5val->proc~dbvalu proc~db6val bspline_sub_module::db6val proc~db6val->proc~dbvalu proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbsgq8->proc~dbvalu proc~dbsqad bspline_sub_module::dbsqad proc~dbsqad->proc~dbvalu interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dbsgq8 proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbvalu ( t , a , n , k , ideriv , x , inbv , work , iflag , val , extrap ) implicit none real ( wp ), intent ( out ) :: val !! the interpolated value integer ( ip ), intent ( in ) :: n !! number of b-spline coefficients. !! (sum of knot multiplicities-`k`) real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k` real ( wp ), dimension ( n ), intent ( in ) :: a !! b-spline coefficient vector of length `n` integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: ideriv !! order of the derivative, `0 <= ideriv <= k-1`. !! `ideriv = 0` returns the b-spline value real ( wp ), intent ( in ) :: x !! argument, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( inout ) :: inbv !! an initialization parameter which must be set !! to 1 the first time [[dbvalu]] is called. !! `inbv` contains information for efficient processing !! after the initial call and `inbv` must not !! be changed by the user. distinct splines require !! distinct `inbv` parameters. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length at least `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 401: `k` does not satisfy `k` \\ge 1 !! * 402: `n` does not satisfy `n` \\ge `k` !! * 403: `ideriv` does not satisfy 0 \\le `ideriv` < `k` !! * 404: `x` is not greater than or equal to `t(k)` !! * 405: `x` is not less than or equal to `t(n+1)` !! * 406: a left limiting value cannot be obtained at `t(k)` logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: i , iderp1 , ihi , ihmkmj , ilo , imk , imkpj , ipj ,& ip1 , ip1mj , j , jj , j1 , j2 , kmider , kmj , km1 , kpk , mflag real ( wp ) :: fkmj real ( wp ) :: xt logical :: extrapolation_allowed !! if extrapolation is allowed val = 0.0_wp if ( k < 1_ip ) then iflag = 401_ip ! dbvalu - k does not satisfy k>=1 return end if if ( n < k ) then iflag = 402_ip ! dbvalu - n does not satisfy n>=k return end if if ( ideriv < 0_ip . or . ideriv >= k ) then iflag = 403_ip ! dbvalu - ideriv does not satisfy 0<=ideriv t ( n + 1_ip )) then xt = t ( n + 1_ip ) else xt = x end if else xt = x end if kmider = k - ideriv ! find *i* in (k,n) such that t(i) <= x < t(i+1) ! (or, <= t(i+1) if t(i) < t(i+1) = t(n+1)). km1 = k - 1_ip call dintrv ( t , n + 1 , xt , inbv , i , mflag ) if ( xt < t ( k )) then iflag = 404_ip ! dbvalu - x is not greater than or equal to t(k) return end if if ( mflag /= 0_ip ) then if ( xt > t ( i )) then iflag = 405_ip ! dbvalu - x is not less than or equal to t(n+1) return end if do if ( i == k ) then iflag = 406_ip ! dbvalu - a left limiting value cannot be obtained at t(k) return end if i = i - 1_ip if ( xt /= t ( i )) exit end do end if ! difference the coefficients *ideriv* times ! work(i) = aj(i), work(k+i) = dp(i), work(k+k+i) = dm(i), i=1.k imk = i - k do j = 1_ip , k imkpj = imk + j work ( j ) = a ( imkpj ) end do if ( ideriv /= 0_ip ) then do j = 1_ip , ideriv kmj = k - j fkmj = real ( kmj , wp ) do jj = 1_ip , kmj ihi = i + jj ihmkmj = ihi - kmj work ( jj ) = ( work ( jj + 1_ip ) - work ( jj )) / ( t ( ihi ) - t ( ihmkmj )) * fkmj end do end do end if ! compute value at *x* in (t(i),(t(i+1)) of ideriv-th derivative, ! given its relevant b-spline coeff. in aj(1),...,aj(k-ideriv). if ( ideriv /= km1 ) then ip1 = i + 1_ip kpk = k + k j1 = k + 1_ip j2 = kpk + 1_ip do j = 1_ip , kmider ipj = i + j work ( j1 ) = t ( ipj ) - x ip1mj = ip1 - j work ( j2 ) = x - t ( ip1mj ) j1 = j1 + 1_ip j2 = j2 + 1_ip end do iderp1 = ideriv + 1_ip do j = iderp1 , km1 kmj = k - j ilo = kmj do jj = 1_ip , kmj work ( jj ) = ( work ( jj + 1_ip ) * work ( kpk + ilo ) + work ( jj ) * & work ( k + jj )) / ( work ( kpk + ilo ) + work ( k + jj )) ilo = ilo - 1 end do end do end if iflag = 0_ip val = work ( 1_ip ) end subroutine dbvalu","tags":"","loc":"proc/dbvalu.html"},{"title":"dintrv – bspline-fortran","text":"private pure subroutine dintrv(xt, lxt, xx, ilo, ileft, mflag, extrap) Computes the largest integer ileft in 1 ileft lxt such that xt(ileft) x where xt(*) is a subdivision of\n the x interval.\n precisely, if x < xt ( 1 ) then ileft = 1 , mflag =- 1 if xt ( i ) <= x < xt ( i + 1 ) then ileft = i , mflag = 0 if xt ( lxt ) <= x then ileft = lxt , mflag =- 2 that is, when multiplicities are present in the break point\n to the left of x , the largest index is taken for ileft . History interv written by carl de boor [5] dintrv author: amos, d. e., (snla) : date written 800901 revision date 820801 Jacob Williams, 2/24/2015 : updated to free-form Fortran. Jacob Williams, 2/17/2016 : additional refactoring (eliminated GOTOs). Jacob Williams, 3/4/2017 : added extrapolation option. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: xt a knot or break point vector of length lxt integer(kind=ip), intent(in) :: lxt length of the xt vector real(kind=wp), intent(in) :: xx argument integer(kind=ip), intent(inout) :: ilo an initialization parameter which must be set\nto 1 the first time the spline array xt is\nprocessed by dintrv. ilo contains information for\nefficient processing after the initial call and ilo must not be changed by the user. distinct splines\nrequire distinct ilo parameters. integer(kind=ip), intent(out) :: ileft largest integer satisfying xt(ileft) x integer(kind=ip), intent(out) :: mflag signals when x lies out of bounds logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~dintrv~~CallsGraph proc~dintrv bspline_sub_module::dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dintrv~~CalledByGraph proc~dintrv bspline_sub_module::dintrv proc~db2val bspline_sub_module::db2val proc~db2val->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~db3val bspline_sub_module::db3val proc~db3val->proc~dintrv proc~db3val->proc~dbvalu proc~db4val bspline_sub_module::db4val proc~db4val->proc~dintrv proc~db4val->proc~dbvalu proc~db5val bspline_sub_module::db5val proc~db5val->proc~dintrv proc~db5val->proc~dbvalu proc~db6val bspline_sub_module::db6val proc~db6val->proc~dintrv proc~db6val->proc~dbvalu proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dintrv proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dbsqad bspline_sub_module::dbsqad proc~dbsqad->proc~dintrv proc~dbsqad->proc~dbvalu proc~dbvalu->proc~dintrv proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~dbvalu proc~dbsgq8->proc~dbvalu proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dintrv ( xt , lxt , xx , ilo , ileft , mflag , extrap ) implicit none integer ( ip ), intent ( in ) :: lxt !! length of the `xt` vector real ( wp ), dimension (:), intent ( in ) :: xt !! a knot or break point vector of length `lxt` real ( wp ), intent ( in ) :: xx !! argument integer ( ip ), intent ( inout ) :: ilo !! an initialization parameter which must be set !! to 1 the first time the spline array `xt` is !! processed by dintrv. `ilo` contains information for !! efficient processing after the initial call and `ilo` !! must not be changed by the user. distinct splines !! require distinct `ilo` parameters. integer ( ip ), intent ( out ) :: ileft !! largest integer satisfying `xt(ileft)` \\le `x` integer ( ip ), intent ( out ) :: mflag !! signals when `x` lies out of bounds logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: ihi , istep , middle real ( wp ) :: x x = get_temp_x_for_extrap ( xx , xt ( 1_ip ), xt ( lxt ), extrap ) ihi = ilo + 1_ip if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if if ( lxt <= 1 ) then mflag = - 1_ip ileft = 1_ip return end if ilo = lxt - 1_ip ihi = lxt end if if ( x >= xt ( ihi ) ) then ! now x >= xt(ilo). find upper bound istep = 1_ip do ilo = ihi ihi = ilo + istep if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if ihi = lxt else if ( x >= xt ( ihi ) ) then istep = istep * 2_ip cycle end if exit end do else if ( x >= xt ( ilo ) ) then mflag = 0_ip ileft = ilo return end if ! now x <= xt(ihi). find lower bound istep = 1_ip do ihi = ilo ilo = ihi - istep if ( ilo <= 1_ip ) then ilo = 1_ip if ( x < xt ( 1_ip ) ) then mflag = - 1_ip ileft = 1_ip return end if else if ( x < xt ( ilo ) ) then istep = istep * 2_ip cycle end if exit end do end if ! now xt(ilo) <= x < xt(ihi). narrow the interval do middle = ( ilo + ihi ) / 2_ip if ( middle == ilo ) then mflag = 0_ip ileft = ilo return end if ! note. it is assumed that middle = ilo in case ihi = ilo+1 if ( x < xt ( middle ) ) then ihi = middle else ilo = middle end if end do end subroutine dintrv","tags":"","loc":"proc/dintrv.html"},{"title":"dbint4 – bspline-fortran","text":"private pure subroutine dbint4(x, y, ndata, ibcl, ibcr, fbcl, fbcr, kntopt, tleft, tright, t, bcoef, n, k, w, iflag) DBINT4 computes the B representation ( t , bcoef , n , k ) of a\n cubic spline ( k=4 ) which interpolates data ( x(i) , y(i) ), i=1,ndata . Parameters ibcl , ibcr , fbcl , fbcr allow the specification of the spline\n first or second derivative at both x(1) and x(ndata) . When this data is not specified\n by the problem, it is common practice to use a natural spline by setting second\n derivatives at x(1) and x(ndata) to zero ( ibcl=ibcr=2 , fbcl=fbcr=0.0 ). The spline is defined on t(4) <= x <= t(n+1) with (ordered) interior knots at x(i) values where n=ndata+2. The knots t(1) , t(2) , t(3) lie to the left of t(4)=x(1) and the knots t(n+2) , t(n+3) , t(n+4) lie to the right of t(n+1)=x(ndata) in increasing order. If no extrapolation outside ( x(1) , x(ndata) ) is anticipated, the\n knots t(1)=t(2)=t(3)=t(4)=x(1) and t(n+2)=t(n+3)=t(n+4)=t(n+1)=x(ndata) can be specified by kntopt=1 . kntopt=2 selects a knot placement for t(1) , t(2) , t(3) to make the\n first 7 knots symmetric about t(4)=x(1) and similarly for t(n+2) , t(n+3) , t(n+4) about t(n+1)=x(ndata) . kntopt=3 allows the user to make his own selection, in increasing order,\n for t(1) , t(2) , t(3) to the left of x(1) and t(n+2) , t(n+3) , t(n+4) to\n the right of x(ndata). In any case, the interpolation on t(4) <= x <= t(n+1) by using function dbvalu is unique for given boundary\n conditions. Error conditions improper input singular system of equations See also dbintk History Written by D. E. Amos (SNLA), August, 1979. date written 800901 revision date 820801 000330 Modified array declarations. (JEC) Jacob Williams, 8/30/2018 : refactored to modern Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x x vector of abscissae of length ndata , distinct\nand in increasing order real(kind=wp), intent(in), dimension(:) :: y y vector of ordinates of length ndata integer(kind=ip), intent(in) :: ndata number of data points, ndata >= 2 integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: ibcl = 1 constrain the first derivative at x(1) to fbcl ibcl = 2 constrain the second derivative at x(1) to fbcl integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: ibcr = 1 constrain first derivative at x(ndata) to fbcr ibcr = 2 constrain second derivative at x(ndata) to fbcr real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: kntopt = 1 sets knot multiplicity at t(4) and t(n+1) to 4 kntopt = 2 sets a symmetric placement of knots\n about t(4) and t(n+1) kntopt = 3 sets t(i)=tleft(i) and t(n+1+i)=tright(i) , i=1,3 real(kind=wp), intent(in), dimension(3) :: tleft when kntopt = 3 : t(1:3) in increasing\norder to be supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright when kntopt = 3 : t(n+2:n+4) in increasing\norder to be supplied by the user. real(kind=wp), intent(out), dimension(:) :: t knot array of length n+4 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length n integer(kind=ip), intent(out) :: n number of coefficients, n=ndata+2 integer(kind=ip), intent(out) :: k order of spline, k=4 real(kind=wp), intent(inout), dimension(5,ndata+2) :: w work array integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 2001: ndata is less than 2 2002: x values are not distinct or not ordered 2003: ibcl is not 1 or 2 2004: ibcr is not 1 or 2 2005: kntopt is not 1, 2, or 3 2006: knot input through tleft , tright is\n not ordered properly 2007: the system of equations is singular Calls proc~~dbint4~~CallsGraph proc~dbint4 bspline_sub_module::dbint4 proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbint4~~CalledByGraph proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbint4 ( x , y , ndata , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , t , bcoef , n , k , w , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `ndata`, distinct !! and in increasing order real ( wp ), dimension (:), intent ( in ) :: y !! y vector of ordinates of length ndata integer ( ip ), intent ( in ) :: ndata !! number of data points, `ndata >= 2` integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(ndata)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(ndata)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(n+1)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(n+1)` !! * `kntopt = 3` sets `t(i)=tleft(i)` and !! `t(n+1+i)=tright(i)`,`i=1,3` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! when `kntopt = 3`: `t(1:3)` in increasing !! order to be supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! when `kntopt = 3`: `t(n+2:n+4)` in increasing !! order to be supplied by the user. real ( wp ), dimension (:), intent ( out ) :: t !! knot array of length `n+4` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `n` integer ( ip ), intent ( out ) :: n !! number of coefficients, `n=ndata+2` integer ( ip ), intent ( out ) :: k !! order of spline, `k=4` real ( wp ), dimension ( 5 , ndata + 2 ), intent ( inout ) :: w !! work array integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 2001: `ndata` is less than 2 !! * 2002: `x` values are not distinct or not ordered !! * 2003: `ibcl` is not 1 or 2 !! * 2004: `ibcr` is not 1 or 2 !! * 2005: `kntopt` is not 1, 2, or 3 !! * 2006: knot input through `tleft`, `tright` is !! not ordered properly !! * 2007: the system of equations is singular integer ( ip ) :: i , ilb , ileft , it , iub , iw , iwp , j , jw , ndm , np , nwrow real ( wp ) :: txn , tx1 , xl real ( wp ), dimension ( 4 , 4 ) :: vnikx real ( wp ), dimension ( 15 ) :: work !! work array for [[dbspvd]] -- length `(k+1)*(k+2)/2` real ( wp ), parameter :: wdtol = epsilon ( 1.0_wp ) !! d1mach(4) real ( wp ), parameter :: tol = sqrt ( wdtol ) if ( ndata < 2_ip ) then iflag = 2001_ip ! ndata is less than 2 return end if ndm = ndata - 1_ip do i = 1_ip , ndm if ( x ( i ) >= x ( i + 1_ip )) then iflag = 2002_ip ! x values are not distinct or not ordered return end if end do if ( ibcl < 1_ip . or . ibcl > 2_ip ) then iflag = 2003_ip ! ibcl is not 1 or 2 return end if if ( ibcr < 1_ip . or . ibcr > 2_ip ) then iflag = 2004_ip ! ibcr is not 1 or 2 return end if if ( kntopt < 1_ip . or . kntopt > 3_ip ) then iflag = 2005_ip ! kntopt is not 1, 2, or 3 return end if iflag = 0_ip k = 4_ip n = ndata + 2_ip np = n + 1_ip do i = 1_ip , ndata t ( i + 3 ) = x ( i ) end do select case ( kntopt ) case ( 1_ip ) ! set up knot array with multiplicity 4 at x(1) and x(ndata) do i = 1 , 3_ip t ( 4 - i ) = x ( 1 ) t ( np + i ) = x ( ndata ) end do case ( 2_ip ) !set up knot array with symmetric placement about end points if ( ndata > 3 ) then tx1 = x ( 1 ) + x ( 1 ) txn = x ( ndata ) + x ( ndata ) do i = 1 , 3 t ( 4 - i ) = tx1 - x ( i + 1 ) t ( np + i ) = txn - x ( ndata - i ) end do else xl = ( x ( ndata ) - x ( 1 )) / 3.0_wp do i = 1 , 3 t ( 4 - i ) = t ( 5 - i ) - xl t ( np + i ) = t ( np + i - 1 ) + xl end do end if case ( 3 ) ! set up knot array less than x(1) and greater than x(ndata) to be ! supplied by user in tleft & tright when kntopt=3 t ( 1 : 3 ) = tleft t ( ndata + 4 : ndata + 6 ) = tright do i = 1 , 3 if (( t ( 4 - i ) > t ( 5 - i )) . or . ( t ( np + i ) < t ( np + i - 1 ))) then iflag = 2006_ip ! knot input through tleft, tright is not ordered properly return end if end do end select w = 0.0_wp ! set up left interpolation point and left boundary condition for ! right limits it = ibcl + 1 call dbspvd ( t , k , it , x ( 1 ), k , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check iw = 0_ip if ( abs ( vnikx ( 3 , 1 )) < tol ) iw = 1_ip do j = 1 , 3 w ( j + 1 , 4 - j ) = vnikx ( 4 - j , it ) w ( j , 4 - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( 1 ) = y ( 1 ) bcoef ( 2 ) = fbcl ! set up interpolation equations for points i=2 to i=ndata-1 ileft = 4_ip if ( ndm >= 2 ) then do i = 2 , ndm ileft = ileft + 1_ip call dbspvd ( t , k , 1_ip , x ( i ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check do j = 1 , 3 w ( j + 1 , 3 + i - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( i + 1 ) = y ( i ) end do end if ! set up right interpolation point and right boundary condition for ! left limits(ileft is associated with t(n)=x(ndata-1)) it = ibcr + 1_ip call dbspvd ( t , k , it , x ( ndata ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check jw = 0_ip if ( abs ( vnikx ( 2 , 1 )) < tol ) jw = 1_ip do j = 1 , 3 w ( j + 1 , 3 + ndata - j ) = vnikx ( 5 - j , it ) w ( j + 2 , 3 + ndata - j ) = vnikx ( 5 - j , 1 ) end do bcoef ( n - 1 ) = fbcr bcoef ( n ) = y ( ndata ) ! solve system of equations ilb = 2_ip - jw iub = 2_ip - iw nwrow = 5_ip iwp = iw + 1_ip call dbnfac ( w ( iwp , 1 ), nwrow , n , ilb , iub , iflag ) if ( iflag == 2_ip ) then iflag = 2007_ip ! the system of equations is singular else iflag = 0_ip ! success call dbnslv ( w ( iwp , 1 ), nwrow , n , ilb , iub , bcoef ) end if end subroutine dbint4","tags":"","loc":"proc/dbint4.html"},{"title":"dbspvd – bspline-fortran","text":"private pure subroutine dbspvd(t, k, nderiv, x, ileft, ldvnik, vnikx, work, iflag) DBSPVD calculates the value and all derivatives of order\n less than nderiv of all basis functions which do not\n (possibly) vanish at x . ileft is input such that t(ileft) <= x < t(ileft+1) . A call to dintrv ( t , n+1 , x , ilo , ileft , mflag ) will produce the proper ileft . The output of\n dbspvd is a matrix vnikx(i,j) of dimension at least (k,nderiv) whose columns contain the k nonzero basis functions and\n their nderiv-1 right derivatives at x , i=1,k, j=1,nderiv .\n These basis functions have indices ileft-k+i , i=1,k,\n k <= ileft <= n . The nonzero part of the i -th basis\n function lies in (t(i),t(i+k)), i=1,n) . If x=t(ileft+1) then vnikx contains left limiting values\n (left derivatives) at t(ileft+1) . In particular, ileft = n produces left limiting values at the right end point x=t(n+1) . To obtain left limiting values at t(i) , i=k+1,n+1 ,\n set x = next lower distinct knot, call dintrv to get ileft ,\n set x=t(i) , and then call dbspvd. History Written by Carl de Boor and modified by D. E. Amos date written 800901 revision date 820801 000330 Modified array declarations. (JEC) Jacob Williams, 8/30/2018 : refactored to modern Fortran. Note DBSPVD is the BSPLVD routine of the reference. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities-k integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: nderiv number of derivatives = nderiv-1 , 1 <= nderiv <= k real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) integer(kind=ip), intent(in) :: ldvnik leading dimension of matrix vnikx real(kind=wp), intent(out), dimension(ldvnik,nderiv) :: vnikx matrix of dimension at least (k,nderiv) containing the nonzero basis functions\nat x and their derivatives columnwise. real(kind=wp), intent(out), dimension(*) :: work a work vector of length (k+1)*(k+2)/2 integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 3001: k does not satisfy k>=1 3002: nderiv does not satisfy 1<=nderiv<=k 3003: ldvnik does not satisfy ldvnik>=k Calls proc~~dbspvd~~CallsGraph proc~dbspvd bspline_sub_module::dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbspvd~~CalledByGraph proc~dbspvd bspline_sub_module::dbspvd proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbspvd proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbspvd ( t , k , nderiv , x , ileft , ldvnik , vnikx , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-k integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: nderiv !! number of derivatives = `nderiv-1`, !! `1 <= nderiv <= k` real ( wp ), intent ( in ) :: x !! argument of basis functions, !! `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that !! `t(ileft) <= x < t(ileft+1)` integer ( ip ), intent ( in ) :: ldvnik !! leading dimension of matrix `vnikx` real ( wp ), dimension ( ldvnik , nderiv ), intent ( out ) :: vnikx !! matrix of dimension at least `(k,nderiv)` !! containing the nonzero basis functions !! at `x` and their derivatives columnwise. real ( wp ), dimension ( * ), intent ( out ) :: work !! a work vector of length `(k+1)*(k+2)/2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 3001: `k` does not satisfy `k>=1` !! * 3002: `nderiv` does not satisfy `1<=nderiv<=k` !! * 3003: `ldvnik` does not satisfy `ldvnik>=k` integer ( ip ) :: i , ideriv , ipkmd , j , jj , jlow , jm , jp1mid , kmd , kp1 , l , ldummy , m , mhigh , iwork real ( wp ) :: factor , fkmd , v ! dimension t(ileft+k), work((k+1)*(k+2)/2) ! a(i,j) = work(i+j*(j+1)/2), i=1,j+1 j=1,k-1 ! a(i,k) = work(i+k*(k-1)/2) i=1.k ! work(1) and work((k+1)*(k+2)/2) are not used. if ( k < 1 ) then iflag = 3001_ip ! k does not satisfy k>=1 return end if if ( nderiv < 1 . or . nderiv > k ) then iflag = 3002_ip ! nderiv does not satisfy 1<=nderiv<=k return end if if ( ldvnik < k ) then iflag = 3003_ip ! ldvnik does not satisfy ldvnik>=k return end if iflag = 0_ip ideriv = nderiv kp1 = k + 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 1_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 . or . ideriv == 1 ) return mhigh = ideriv do m = 2 , mhigh jp1mid = 1 do j = ideriv , k vnikx ( j , ideriv ) = vnikx ( jp1mid , 1 ) jp1mid = jp1mid + 1 end do ideriv = ideriv - 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 2_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 ) return end do jm = kp1 * ( kp1 + 1 ) / 2 do l = 1 , jm work ( l ) = 0.0_wp end do ! a(i,i) = work(i*(i+3)/2) = 1.0 i = 1,k l = 2 j = 0 do i = 1 , k j = j + l work ( j ) = 1.0_wp l = l + 1 end do kmd = k do m = 2 , mhigh kmd = kmd - 1 fkmd = real ( kmd , wp ) i = ileft j = k jj = j * ( j + 1 ) / 2 jm = jj - j do ldummy = 1 , kmd ipkmd = i + kmd factor = fkmd / ( t ( ipkmd ) - t ( i )) do l = 1 , j work ( l + jj ) = ( work ( l + jj ) - work ( l + jm )) * factor end do i = i - 1 j = j - 1 jj = jm jm = jm - j end do do i = 1 , k v = 0.0_wp jlow = max ( i , m ) jj = jlow * ( jlow + 1 ) / 2 do j = jlow , k v = work ( i + jj ) * vnikx ( j , m ) + v jj = jj + j + 1 end do vnikx ( i , m ) = v end do end do end subroutine dbspvd","tags":"","loc":"proc/dbspvd.html"},{"title":"dbsqad – bspline-fortran","text":"private pure subroutine dbsqad(t, bcoef, n, k, x1, x2, bquad, work, iflag) DBSQAD computes the integral on (x1,x2) of a k -th order\n b-spline using the b-representation (t,bcoef,n,k) . orders k as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. If orders k greater than 20 are needed, use dbfqad with f(x) = 1 . Note The maximum number of significant digits obtainable in\n DBSQAD is the smaller of ~300 and the number of digits\n carried in real(wp) arithmetic. References D. E. Amos, \"Quadrature subroutines for splines and\n B-splines\", Report SAND79-1825, Sandia Laboratories,\n December 1979. History Author: Amos, D. E., (SNLA) 800901 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890531 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900326 Removed duplicate information from DESCRIPTION section. (WRB) 920501 Reformatted the REFERENCES section. (WRB) Jacob Williams, 9/6/2017 : refactored to modern Fortran.\n Added higher precision coefficients. Note Extrapolation is not enabled for this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot array of length n+k real(kind=wp), intent(in), dimension(:) :: bcoef b-spline coefficient array of length n integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(out) :: bquad integral of the b-spline over ( x1 , x2 ) real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 901: k does not satisfy 1<=k<=20 902: n does not satisfy n>=k 903: x1 or x2 or both do\n not satisfy t(k)<=x<=t(n+1) Calls proc~~dbsqad~~CallsGraph proc~dbsqad bspline_sub_module::dbsqad proc~dbvalu bspline_sub_module::dbvalu proc~dbsqad->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbsqad->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbsqad~~CalledByGraph proc~dbsqad bspline_sub_module::dbsqad proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbsqad ( t , bcoef , n , k , x1 , x2 , bquad , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot array of length `n+k` real ( wp ), dimension (:), intent ( in ) :: bcoef !! b-spline coefficient array of length `n` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `1 <= k <= 20` real ( wp ), intent ( in ) :: x1 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( out ) :: bquad !! integral of the b-spline over (`x1`,`x2`) real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 901: `k` does not satisfy `1<=k<=20` !! * 902: `n` does not satisfy `n>=k` !! * 903: `x1` or `x2` or both do !! not satisfy `t(k)<=x<=t(n+1)` integer ( ip ) :: i , il1 , il2 , ilo , inbv , jf , left , m , mf , mflag , npk , np1 real ( wp ) :: a , aa , b , bb , bma , bpa , c1 , gx , q , ta , tb , y1 , y2 real ( wp ), dimension ( 5 ) :: s !! sum real ( wp ), dimension ( 9 ), parameter :: gpts = [ & & 0.577350269189625764509148780501957455647601751270126876018602326483977 & & 67230293334569371539558574952522520871380513556767665664836499965082627 & & 05518373647912161760310773007685273559916067003615583077550051041144223 & & 01107628883557418222973945990409015710553455953862673016662179126619796 & & 4892168_wp ,& & 0.238619186083196908630501721680711935418610630140021350181395164574274 & & 93427563984224922442725734913160907222309701068720295545303507720513526 & & 28872175189982985139866216812636229030578298770859440976999298617585739 & & 46921613621659222233462641640013936777894532787145324672151888999339900 & & 0945406150514997832_wp ,& & 0.661209386466264513661399595019905347006448564395170070814526705852183 & & 49660714310094428640374646145642988837163927514667955734677222538043817 & & 23198010093367423918538864300079016299442625145884902455718821970386303 & & 22362011735232135702218793618906974301231555871064213101639896769013566 & & 1651261150514997832_wp ,& & 0.932469514203152027812301554493994609134765737712289824872549616526613 & & 50084420019627628873992192598504786367972657283410658797137951163840419 & & 21786180750210169211578452038930846310372961174632524612619760497437974 & & 07422632089671621172178385230505104744277222209386367655366917903888025 & & 2326771150514997832_wp ,& & 0.148874338981631210884826001129719984617564859420691695707989253515903 & & 61735566852137117762979946369123003116080525533882610289018186437654023 & & 16761969968090913050737827720371059070942475859422743249837177174247346 & & 21691485290294292900319346665908243383809435507599683357023000500383728 & & 0634351_wp ,& & 0.433395394129247190799265943165784162200071837656246496502701513143766 & & 98907770350122510275795011772122368293504099893794727422475772324920512 & & 67741032822086200952319270933462032011328320387691584063411149801129823 & & 14148878744320432476641442157678880770848387945248811854979703928792696 & & 4254222_wp ,& & 0.679409568299024406234327365114873575769294711834809467664817188952558 & & 57539507492461507857357048037949983390204739931506083674084257663009076 & & 82741718202923543197852846977409718369143712013552962837733153108679126 & & 93254495485472934132472721168027426848661712101171203022718105101071880 & & 4444161_wp ,& & 0.865063366688984510732096688423493048527543014965330452521959731845374 & & 75513805556135679072894604577069440463108641176516867830016149345356373 & & 92729396890950011571349689893051612072435760480900979725923317923795535 & & 73929059587977695683242770223694276591148364371481692378170157259728913 & & 9322313_wp ,& & 0.973906528517171720077964012084452053428269946692382119231212066696595 & & 20323463615962572356495626855625823304251877421121502216860143447777992 & & 05409587259942436704413695764881258799146633143510758737119877875210567 & & 06745243536871368303386090938831164665358170712568697066873725922944928 & & 4383797_wp ] real ( wp ), dimension ( 9 ), parameter :: gwts = [ & & 1.0_wp ,& & 0.467913934572691047389870343989550994811655605769210535311625319963914 & & 20162039812703111009258479198230476626878975479710092836255417350295459 & & 35635592733866593364825926382559018030281273563502536241704619318259000 & & 99756987095900533474080074634376824431808173206369174103416261765346292 & & 7888917150514997832_wp ,& & 0.360761573048138607569833513837716111661521892746745482289739240237140 & & 03783726171832096220198881934794311720914037079858987989027836432107077 & & 67872114085818922114502722525757771126000732368828591631602895111800517 & & 40813685547074482472486101183259931449817216402425586777526768199930950 & & 3106873150514997832_wp ,& & 0.171324492379170345040296142172732893526822501484043982398635439798945 & & 76054234015464792770542638866975211652206987440430919174716746217597462 & & 96492293180314484520671351091683210843717994067668872126692485569940481 & & 59429327357024984053433824182363244118374610391205239119044219703570297 & & 7497812150514997832_wp ,& & 0.295524224714752870173892994651338329421046717026853601354308029755995 & & 93821715232927035659579375421672271716440125255838681849078955200582600 & & 19363424941869666095627186488841680432313050615358674090830512706638652 & & 87483901746874726597515954450775158914556548308329986393605934912382356 & & 670244_wp ,& & 0.269266719309996355091226921569469352859759938460883795800563276242153 & & 43231917927676422663670925276075559581145036869830869292346938114524155 & & 64658846634423711656014432259960141729044528030344411297902977067142537 & & 53480628460839927657500691168674984281408628886853320804215041950888191 & & 6391898_wp ,& & 0.219086362515982043995534934228163192458771870522677089880956543635199 & & 91065295128124268399317720219278659121687281288763476662690806694756883 & & 09211843316656677105269915322077536772652826671027878246851010208832173 & & 32006427348325475625066841588534942071161341022729156547776892831330068 & & 8702802_wp ,& & 0.149451349150580593145776339657697332402556639669427367835477268753238 & & 65472663001094594726463473195191400575256104543633823445170674549760147 & & 13716011937109528798134828865118770953566439639333773939909201690204649 & & 08381561877915752257830034342778536175692764212879241228297015017259084 & & 2897331_wp ,& & 0.066671344308688137593568809893331792857864834320158145128694881613412 & & 06408408710177678550968505887782109005471452041933148750712625440376213 & & 93049873169940416344953637064001870112423155043935262424506298327181987 & & 18647480566044117862086478449236378557180717569208295026105115288152794 & & 421677_wp ] iflag = 0_ip bquad = 0.0_wp if ( k < 1_ip . or . k > 20_ip ) then iflag = 901_ip ! error return else if ( n < k ) then iflag = 902_ip ! error return else aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ! selection of 2, 6, or 10 point gauss formula jf = 0_ip mf = 1_ip if ( k > 4_ip ) then jf = 1_ip mf = 3_ip if ( k > 12_ip ) then jf = 4_ip mf = 5_ip end if end if do i = 1_ip , mf s ( i ) = 0.0_wp end do ilo = 1_ip inbv = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) bma = 0.5_wp * ( b - a ) bpa = 0.5_wp * ( b + a ) do m = 1_ip , mf c1 = bma * gpts ( jf + m ) gx = - c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y2 ) if ( iflag /= 0_ip ) return gx = c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y1 ) if ( iflag /= 0_ip ) return s ( m ) = s ( m ) + ( y1 + y2 ) * bma end do end if end do q = 0.0_wp do m = 1_ip , mf q = q + gwts ( jf + m ) * s ( m ) end do if ( x1 > x2 ) q = - q bquad = q return end if end if iflag = 903_ip ! error return end if end subroutine dbsqad","tags":"","loc":"proc/dbsqad.html"},{"title":"dbfqad – bspline-fortran","text":"private subroutine dbfqad(f, t, bcoef, n, k, id, x1, x2, tol, quad, iflag, work) dbfqad computes the integral on (x1,x2) of a product of a\n function f and the id -th derivative of a k -th order b-spline,\n using the b-representation (t,bcoef,n,k) . (x1,x2) must be a\n subinterval of t(k) <= x <= t(n+1) . an integration routine, dbsgq8 (a modification of gaus8 ), integrates the product\n on subintervals of (x1,x2) formed by included (distinct) knots Reference D. E. Amos, \"Quadrature subroutines for splines and\n B-splines\", Report SAND79-1825, Sandia Laboratories,\n December 1979. History 800901 Amos, D. E., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890531 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900326 Removed duplicate information from DESCRIPTION section. (WRB) 920501 Reformatted the REFERENCES section. (WRB) Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes. Note the maximum number of significant digits obtainable in dbsqad is the smaller of ~300 and the number of digits\n carried in real(wp) arithmetic. Note Extrapolation is not enabled for this routine. Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: f external function of one argument for the\nintegrand bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work) real(kind=wp), intent(in), dimension(n+k) :: t knot array real(kind=wp), intent(in), dimension(n) :: bcoef coefficient array integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, k >= 1 integer(kind=ip), intent(in) :: id order of the spline derivative, 0 <= id <= k-1 id=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: quad integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 1001: k does not satisfy k>=1 1002: n does not satisfy n>=k 1003: d does not satisfy 0<=idproc~dbsgq8 proc~dintrv bspline_sub_module::dintrv proc~dbfqad->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap proc~dbvalu->proc~dintrv Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbfqad~~CalledByGraph proc~dbfqad bspline_sub_module::dbfqad proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbfqad ( f , t , bcoef , n , k , id , x1 , x2 , tol , quad , iflag , work ) implicit none procedure ( b1fqad_func ) :: f !! external function of one argument for the !! integrand `bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work)` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `k >= 1` real ( wp ), dimension ( n + k ), intent ( in ) :: t !! knot array real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! coefficient array integer ( ip ), intent ( in ) :: id !! order of the spline derivative, `0 <= id <= k-1` !! `id=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: quad !! integral of `bf(x)` on `(x1,x2)` real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 1001: `k` does not satisfy `k>=1` !! * 1002: `n` does not satisfy `n>=k` !! * 1003: `d` does not satisfy `0<=id= k ) then iflag = 1003_ip ! error else if ( tol >= min_tol . and . tol <= 0.1_wp ) then aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ilo = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n inbv = 1_ip q = 0.0_wp do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) call dbsgq8 ( f , t , bcoef , n , k , id , a , b , inbv , err , ans , iflag , work ) if ( iflag /= 0_ip . and . iflag /= 1101_ip ) return q = q + ans end if end do if ( x1 > x2 ) q = - q quad = q end if else iflag = 1004_ip ! error end if else iflag = 1005_ip ! error end if end if end subroutine dbfqad","tags":"","loc":"proc/dbfqad.html"},{"title":"dbsgq8 – bspline-fortran","text":"private subroutine dbsgq8(fun, xt, bc, n, kk, id, a, b, inbv, err, ans, iflag, work) DBSGQ8, a modification of gaus8 ,\n integrates the product of fun(x) by the id -th derivative of a spline dbvalu between limits a and b using an adaptive 8-point Legendre-Gauss\n algorithm. See also dbfqad History 800901 Jones, R. E., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890911 Removed unnecessary intrinsics. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900326 Removed duplicate information from DESCRIPTION section. (WRB) 900328 Added TYPE section. (WRB) 910408 Updated the AUTHOR section. (WRB) Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes.\n Added higher precision coefficients. Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun name of external function of one\nargument which multiplies dbvalu . real(kind=wp), intent(in), dimension(:) :: xt knot array for dbvalu real(kind=wp), intent(in), dimension(n) :: bc b-coefficient array for dbvalu integer(kind=ip), intent(in) :: n number of b-coefficients for dbvalu integer(kind=ip), intent(in) :: kk order of the spline, kk>=1 integer(kind=ip), intent(in) :: id Order of the spline derivative, 0<=id<=kk-1 real(kind=wp), intent(in) :: a lower limit of integral real(kind=wp), intent(in) :: b upper limit of integral (may be less than a ) integer(kind=ip), intent(inout) :: inbv initialization parameter for dbvalu real(kind=wp), intent(inout) :: err IN: is a requested pseudorelative error\ntolerance. normally pick a value of abs(err)<1e-3 . ans will normally\nhave no more error than abs(err) times\nthe integral of the absolute value of fun(x)*[[dbvalu]]() . OUT: will be an estimate of the absolute\nerror in ans if the input value of err was negative. ( err is unchanged if\nthe input value of err was nonnegative.)\nthe estimated error is solely for information\nto the user and should not be used as a\ncorrection to the computed integral. real(kind=wp), intent(out) :: ans computed value of integral integer(kind=ip), intent(out) :: iflag a status code: 0: ans most likely meets requested\n error tolerance, or a=b . 1101: a and b are too nearly equal\n to allow normal integration. ans is set to zero. 1102: ans probably does not meet\n requested error tolerance. real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k for dbvalu Calls proc~~dbsgq8~~CallsGraph proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbsgq8~~CalledByGraph proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dbsgq8 proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbsgq8 ( fun , xt , bc , n , kk , id , a , b , inbv , err , ans , iflag , work ) implicit none procedure ( b1fqad_func ) :: fun !! name of external function of one !! argument which multiplies [[dbvalu]]. integer ( ip ), intent ( in ) :: n !! number of b-coefficients for [[dbvalu]] integer ( ip ), intent ( in ) :: kk !! order of the spline, `kk>=1` real ( wp ), dimension (:), intent ( in ) :: xt !! knot array for [[dbvalu]] real ( wp ), dimension ( n ), intent ( in ) :: bc !! b-coefficient array for [[dbvalu]] integer ( ip ), intent ( in ) :: id !! Order of the spline derivative, `0<=id<=kk-1` real ( wp ), intent ( in ) :: a !! lower limit of integral real ( wp ), intent ( in ) :: b !! upper limit of integral (may be less than `a`) integer ( ip ), intent ( inout ) :: inbv !! initialization parameter for [[dbvalu]] real ( wp ), intent ( inout ) :: err !! **IN:** is a requested pseudorelative error !! tolerance. normally pick a value of !! `abs(err)<1e-3`. `ans` will normally !! have no more error than `abs(err)` times !! the integral of the absolute value of !! `fun(x)*[[dbvalu]]()`. !! !! **OUT:** will be an estimate of the absolute !! error in ans if the input value of `err` !! was negative. (`err` is unchanged if !! the input value of `err` was nonnegative.) !! the estimated error is solely for information !! to the user and should not be used as a !! correction to the computed integral. real ( wp ), intent ( out ) :: ans !! computed value of integral integer ( ip ), intent ( out ) :: iflag !! a status code: !! !! * 0: `ans` most likely meets requested !! error tolerance, or `a=b`. !! * 1101: `a` and `b` are too nearly equal !! to allow normal integration. !! `ans` is set to zero. !! * 1102: `ans` probably does not meet !! requested error tolerance. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` for [[dbvalu]] integer ( ip ) :: k , l , lmn , lmx , mxl , nbits , nib , nlmx real ( wp ) :: ae , anib , area , c , ce , ee , ef , eps , est , gl , glr , tol , vr , x integer ( ip ), dimension ( 60 ) :: lr real ( wp ), dimension ( 60 ) :: aa , hh , vl , gr integer ( ip ), parameter :: i1mach14 = digits ( 1.0_wp ) !! i1mach(14) real ( wp ), parameter :: d1mach5 = log10 ( real ( radix ( x ), wp )) !! d1mach(5) real ( wp ), parameter :: ln2 = log ( 2.0_wp ) !! 0.69314718d0 real ( wp ), parameter :: sq2 = sqrt ( 2.0_wp ) integer ( ip ), parameter :: nlmn = 1 integer ( ip ), parameter :: kmx = 5000 integer ( ip ), parameter :: kml = 6 ! initialize inbv = 1_ip iflag = 0_ip k = i1mach14 anib = d1mach5 * k / 0.30102000_wp nbits = int ( anib , ip ) nlmx = min (( nbits * 5_ip ) / 8_ip , 60_ip ) ans = 0.0_wp ce = 0.0_wp if ( a == b ) then if ( err < 0.0_wp ) err = ce else lmx = nlmx lmn = nlmn if ( b /= 0.0_wp ) then if ( sign ( 1.0_wp , b ) * a > 0.0_wp ) then c = abs ( 1.0_wp - a / b ) if ( c <= 0.1_wp ) then if ( c <= 0.0_wp ) then if ( err < 0.0_wp ) err = ce return else anib = 0.5_wp - log ( c ) / ln2 nib = int ( anib , ip ) lmx = min ( nlmx , nbits - nib - 7_ip ) if ( lmx < 1_ip ) then ! a and b are too nearly equal ! to allow normal integration iflag = 1101_ip if ( err < 0.0_wp ) err = ce return else lmn = min ( lmn , lmx ) end if end if end if end if end if tol = max ( abs ( err ), 2.0_wp ** ( 5 - nbits )) / 2.0_wp if ( err == 0.0_wp ) tol = sqrt ( epsilon ( 1.0_wp )) eps = tol hh ( 1_ip ) = ( b - a ) / 4.0_wp aa ( 1_ip ) = a lr ( 1_ip ) = 1_ip l = 1_ip call g8 ( aa ( l ) + 2.0_wp * hh ( l ), 2.0_wp * hh ( l ), est , iflag ) if ( iflag /= 0_ip ) return k = 8_ip area = abs ( est ) ef = 0.5_wp mxl = 0_ip end if do ! compute refined estimates, estimate the error, etc. call g8 ( aa ( l ) + hh ( l ), hh ( l ), gl , iflag ) if ( iflag /= 0_ip ) return call g8 ( aa ( l ) + 3.0_wp * hh ( l ), hh ( l ), gr ( l ), iflag ) if ( iflag /= 0_ip ) return k = k + 16_ip area = area + ( abs ( gl ) + abs ( gr ( l )) - abs ( est )) glr = gl + gr ( l ) ee = abs ( est - glr ) * ef ae = max ( eps * area , tol * abs ( glr )) if ( ee > ae ) then ! consider the left half of this level if ( k > kmx ) lmx = kml if ( l >= lmx ) then mxl = 1_ip else l = l + 1_ip eps = eps * 0.5_wp ef = ef / sq2 hh ( l ) = hh ( l - 1 ) * 0.5_wp lr ( l ) = - 1_ip aa ( l ) = aa ( l - 1_ip ) est = gl cycle end if end if ce = ce + ( est - glr ) if ( lr ( l ) <= 0_ip ) then ! proceed to right half at this level vl ( l ) = glr else ! return one level vr = glr do if ( l <= 1_ip ) then ! exit ans = vr if ( ( mxl /= 0_ip ) . and . ( abs ( ce ) > 2.0_wp * tol * area ) ) then iflag = 1102_ip end if if ( err < 0.0_wp ) err = ce return else l = l - 1_ip eps = eps * 2.0_wp ef = ef * sq2 if ( lr ( l ) <= 0 ) then vl ( l ) = vl ( l + 1_ip ) + vr exit else vr = vl ( l + 1_ip ) + vr end if end if end do end if est = gr ( l - 1_ip ) lr ( l ) = 1_ip aa ( l ) = aa ( l ) + 4.0_wp * hh ( l ) end do contains subroutine g8 ( x , h , res , iflag ) !! 8-point formula. !! !!@note Replaced the original double precision abscissa and weight !! coefficients with the higher precision versions from here: !! http://pomax.github.io/bezierinfo/legendre-gauss.html !! So, if `wp` is changed to say, `real128`, more precision !! can be obtained. These coefficients have about 300 digits. implicit none real ( wp ), intent ( in ) :: x real ( wp ), intent ( in ) :: h real ( wp ), intent ( out ) :: res integer ( ip ), intent ( out ) :: iflag real ( wp ), dimension ( 8 ) :: f real ( wp ), dimension ( 8 ) :: v ! abscissa and weight coefficients: real ( wp ), parameter :: x1 = & & 0.1834346424956498049394761423601839806667578129129737823171884736992044 & & 742215421141160682237111233537452676587642867666089196012523876865683788 & & 569995160663568104475551617138501966385810764205532370882654749492812314 & & 961247764619363562770645716456613159405134052985058171969174306064445289 & & 638150514997832_wp real ( wp ), parameter :: x2 = & & 0.5255324099163289858177390491892463490419642431203928577508570992724548 & & 207685612725239614001936319820619096829248252608507108793766638779939805 & & 395303668253631119018273032402360060717470006127901479587576756241288895 & & 336619643528330825624263470540184224603688817537938539658502113876953598 & & 879150514997832_wp real ( wp ), parameter :: x3 = & & 0.7966664774136267395915539364758304368371717316159648320701702950392173 & & 056764730921471519272957259390191974534530973092653656494917010859602772 & & 562074621689676153935016290342325645582634205301545856060095727342603557 & & 415761265140428851957341933710803722783136113628137267630651413319993338 & & 002150514997832_wp real ( wp ), parameter :: x4 = & & 0.9602898564975362316835608685694729904282352343014520382716397773724248 & & 977434192844394389592633122683104243928172941762102389581552171285479373 & & 642204909699700433982618326637346808781263553346927867359663480870597542 & & 547603929318533866568132868842613474896289232087639988952409772489387324 & & 25615051499783203_wp real ( wp ), parameter :: w1 = & & 0.3626837833783619829651504492771956121941460398943305405248230675666867 & & 347239066773243660420848285095502587699262967065529258215569895173844995 & & 576007862076842778350382862546305771007553373269714714894268328780431822 & & 779077846722965535548199601402487767505928976560993309027632737537826127 & & 502150514997832_wp real ( wp ), parameter :: w2 = & & 0.3137066458778872873379622019866013132603289990027349376902639450749562 & & 719421734969616980762339285560494275746410778086162472468322655616056890 & & 624276469758994622503118776562559463287222021520431626467794721603822601 & & 295276898652509723185157998353156062419751736972560423953923732838789657 & & 919150514997832_wp real ( wp ), parameter :: w3 = & & 0.2223810344533744705443559944262408844301308700512495647259092892936168 & & 145704490408536531423771979278421592661012122181231114375798525722419381 & & 826674532090577908613289536840402789398648876004385697202157482063253247 & & 195590228631570651319965589733545440605952819880671616779621183704306688 & & 233150514997832_wp real ( wp ), parameter :: w4 = & & 0.1012285362903762591525313543099621901153940910516849570590036980647401 & & 787634707848602827393040450065581543893314132667077154940308923487678731 & & 973041136073584690533208824050731976306575729205467961435779467552492328 & & 730055025992954089946676810510810729468366466585774650346143712142008566 & & 866150514997832_wp res = 0.0_wp v ( 1_ip ) = x - x1 * h v ( 2_ip ) = x + x1 * h v ( 3_ip ) = x - x2 * h v ( 4_ip ) = x + x2 * h v ( 5_ip ) = x - x3 * h v ( 6_ip ) = x + x3 * h v ( 7_ip ) = x - x4 * h v ( 8_ip ) = x + x4 * h call dbvalu ( xt , bc , n , kk , id , v ( 1_ip ), inbv , work , iflag , f ( 1_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 2_ip ), inbv , work , iflag , f ( 2_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 3_ip ), inbv , work , iflag , f ( 3_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 4_ip ), inbv , work , iflag , f ( 4_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 5_ip ), inbv , work , iflag , f ( 5_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 6_ip ), inbv , work , iflag , f ( 6_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 7_ip ), inbv , work , iflag , f ( 7_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 8_ip ), inbv , work , iflag , f ( 8_ip )); if ( iflag /= 0_ip ) return res = h * (( w1 * ( fun ( v ( 1_ip )) * f ( 1_ip ) + fun ( v ( 2_ip )) * f ( 2_ip )) + & w2 * ( fun ( v ( 3_ip )) * f ( 3_ip ) + fun ( v ( 4_ip )) * f ( 4_ip ))) + & ( w3 * ( fun ( v ( 5_ip )) * f ( 5_ip ) + fun ( v ( 6_ip )) * f ( 6_ip )) + & w4 * ( fun ( v ( 7_ip )) * f ( 7_ip ) + fun ( v ( 8_ip )) * f ( 8_ip )))) end subroutine g8 end subroutine dbsgq8","tags":"","loc":"proc/dbsgq8.html"},{"title":"db1ink – bspline-fortran","text":"public interface db1ink 1D initialization routines. Calls interface~~db1ink~~CallsGraph interface~db1ink bspline_sub_module::db1ink proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by interface~~db1ink~~CalledByGraph interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure subroutine db1ink_default (x, nx, fcn, kx, iknot, tx, bcoef, iflag) Determines the parameters of a function that interpolates\n the one-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db1val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant: Read more… real(kind=wp), intent(out), dimension(:) :: bcoef (nx) array of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt_2 (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more…","tags":"","loc":"interface/db1ink.html"},{"title":"db1val – bspline-fortran","text":"public interface db1val 1D evaluation routines. Calls interface~~db1val~~CallsGraph interface~db1val bspline_sub_module::db1val proc~db1val_alt bspline_sub_module::db1val_alt interface~db1val->proc~db1val_alt proc~db1val_default bspline_sub_module::db1val_default interface~db1val->proc~db1val_default proc~check_value bspline_sub_module::check_value proc~db1val_alt->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt->proc~dbvalu proc~db1val_default->proc~check_value proc~db1val_default->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by interface~~db1val~~CalledByGraph interface~db1val bspline_sub_module::db1val proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure subroutine db1val_default (xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine db1val_alt (xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False)","tags":"","loc":"interface/db1val.html"},{"title":"ddot – bspline-fortran","text":"public function ddot(n, dx, incx, dy, incy) ddot forms the dot product of two vectors.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Return Value real(kind=wp) Called by proc~~ddot~~CalledByGraph proc~ddot bspline_blas_module::ddot proc~dcv bspline_defc_module::dcv proc~dcv->proc~ddot proc~dh12 bspline_defc_module::dh12 proc~dh12->proc~ddot proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~ddot proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~ddot proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dlpdp proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dbndac bspline_defc_module::dbndac proc~dbndac->proc~dh12 proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfcmn->proc~dbndac proc~dhfti->proc~dh12 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dh12 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dwnlit proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dwnnls->proc~dwnlsm proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code real ( wp ) function ddot ( n , dx , incx , dy , incy ) !! ddot forms the dot product of two vectors. !! uses unrolled loops for increments equal to one. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 ddot = 0.0_wp dtemp = 0.0_wp if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dtemp + dx ( i ) * dy ( i ) end do if ( n < 5_ip ) then ddot = dtemp return end if end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dtemp = dtemp + dx ( i ) * dy ( i ) + & dx ( i + 1_ip ) * dy ( i + 1_ip ) + dx ( i + 2_ip ) * dy ( i + 2_ip ) + & dx ( i + 3_ip ) * dy ( i + 3_ip ) + dx ( i + 4_ip ) * dy ( i + 4_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dtemp + dx ( ix ) * dy ( iy ) ix = ix + incx iy = iy + incy end do end if ddot = dtemp end function ddot","tags":"","loc":"proc/ddot.html"},{"title":"dnrm2 – bspline-fortran","text":"public function dnrm2(n, x, incx) returns the euclidean norm of a vector Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: x (*) integer(kind=ip) :: incx Return Value real(kind=wp) Called by proc~~dnrm2~~CalledByGraph proc~dnrm2 bspline_blas_module::dnrm2 proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dnrm2 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dnrm2 proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dlsi->proc~dlpdp proc~dwnnls->proc~dwnlsm proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module.","tags":"","loc":"proc/dnrm2.html"},{"title":"dasum – bspline-fortran","text":"public function dasum(n, dx, incx) dasum takes the sum of the absolute values. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value real(kind=wp) Called by proc~~dasum~~CalledByGraph proc~dasum bspline_blas_module::dasum proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dasum proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dasum proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dasum proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dlpdp->proc~dwnnls Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code real ( wp ) function dasum ( n , dx , incx ) !! dasum takes the sum of the absolute values. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) dtemp integer ( ip ) i , m , mp1 , nincx dasum = 0.0_wp dtemp = 0.0_wp if ( n <= 0 . or . incx <= 0 ) return if ( incx == 1 ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 6 ) if ( m /= 0 ) then do i = 1 , m dtemp = dtemp + abs ( dx ( i )) end do if ( n < 6 ) then dasum = dtemp return end if end if mp1 = m + 1 do i = mp1 , n , 6 dtemp = dtemp + abs ( dx ( i )) + abs ( dx ( i + 1 )) + & abs ( dx ( i + 2 )) + abs ( dx ( i + 3 )) + & abs ( dx ( i + 4 )) + abs ( dx ( i + 5 )) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1 , nincx , incx dtemp = dtemp + abs ( dx ( i )) end do end if dasum = dtemp end function dasum","tags":"","loc":"proc/dasum.html"},{"title":"idamax – bspline-fortran","text":"public function idamax(n, dx, incx) idamax finds the index of the first element having maximum absolute value. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value integer Called by proc~~idamax~~CalledByGraph proc~idamax bspline_blas_module::idamax proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~idamax proc~dwnlsm->proc~dwnlit proc~dwnlt1->proc~idamax proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code integer function idamax ( n , dx , incx ) !! idamax finds the index of the first element having maximum absolute value. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) :: dmax integer ( ip ) :: i , ix idamax = 0 if ( n < 1 . or . incx <= 0 ) return idamax = 1 if ( n == 1 ) return if ( incx == 1 ) then ! code for increment equal to 1 dmax = abs ( dx ( 1 )) do i = 2 , n if ( abs ( dx ( i )) > dmax ) then idamax = i dmax = abs ( dx ( i )) end if end do else ! code for increment not equal to 1 ix = 1 dmax = abs ( dx ( 1 )) ix = ix + incx do i = 2 , n if ( abs ( dx ( ix )) > dmax ) then idamax = i dmax = abs ( dx ( ix )) end if ix = ix + incx end do end if end function idamax","tags":"","loc":"proc/idamax.html"},{"title":"daxpy – bspline-fortran","text":"public subroutine daxpy(n, da, dx, incx, dy, incy) DAXPY constant times a vector plus a vector.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Called by proc~~daxpy~~CalledByGraph proc~daxpy bspline_blas_module::daxpy proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~daxpy proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dbndac bspline_defc_module::dbndac proc~dfcmn->proc~dbndac proc~dh12 bspline_defc_module::dh12 proc~dh12->proc~daxpy proc~dlsei->proc~daxpy proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~daxpy proc~dlsi->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dh12 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~dbndac->proc~dh12 proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dhfti->proc~dh12 proc~dwnlit->proc~dh12 proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dlpdp->proc~dwnnls proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine daxpy ( n , da , dx , incx , dy , incy ) !! DAXPY constant times a vector plus a vector. !! uses unrolled loops for increments equal to one. real ( wp ) :: da integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( da == 0.0_wp ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 4_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dy ( i ) + da * dx ( i ) end do end if if ( n < 4_ip ) return mp1 = m + 1_ip do i = mp1 , n , 4_ip dy ( i ) = dy ( i ) + da * dx ( i ) dy ( i + 1_ip ) = dy ( i + 1_ip ) + da * dx ( i + 1_ip ) dy ( i + 2_ip ) = dy ( i + 2_ip ) + da * dx ( i + 2_ip ) dy ( i + 3_ip ) = dy ( i + 3_ip ) + da * dx ( i + 3_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dy ( iy ) + da * dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine daxpy","tags":"","loc":"proc/daxpy.html"},{"title":"dcopy – bspline-fortran","text":"public subroutine dcopy(n, dx, incx, dy, incy) DCOPY copies a vector, x, to a vector, y.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Called by proc~~dcopy~~CalledByGraph proc~dcopy bspline_blas_module::dcopy proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dcopy proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dcopy proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dcopy proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei->proc~dcopy proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dcopy proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dcopy proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dwnlit proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dwnnls->proc~dwnlsm Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dcopy ( n , dx , incx , dy , incy ) !! DCOPY copies a vector, x, to a vector, y. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 7_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dx ( i ) end do if ( n < 7_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 7_ip dy ( i ) = dx ( i ) dy ( i + 1_ip ) = dx ( i + 1_ip ) dy ( i + 2_ip ) = dx ( i + 2_ip ) dy ( i + 3_ip ) = dx ( i + 3_ip ) dy ( i + 4_ip ) = dx ( i + 4_ip ) dy ( i + 5_ip ) = dx ( i + 5_ip ) dy ( i + 6_ip ) = dx ( i + 6_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine dcopy","tags":"","loc":"proc/dcopy.html"},{"title":"dscal – bspline-fortran","text":"public subroutine dscal(n, da, dx, incx) DSCAL scales a vector by a constant.\nuses unrolled loops for increment equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx Called by proc~~dscal~~CalledByGraph proc~dscal bspline_blas_module::dscal proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dscal proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dscal proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dscal proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei->proc~dscal proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dscal proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dscal proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dwnlit proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dwnnls->proc~dwnlsm Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dscal ( n , da , dx , incx ) !! DSCAL scales a vector by a constant. !! uses unrolled loops for increment equal to 1. real ( wp ) :: da integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) integer i , m , mp1 , nincx if ( n <= 0_ip . or . incx <= 0_ip ) return if ( incx == 1_ip ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dx ( i ) = da * dx ( i ) end do if ( n < 5_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dx ( i ) = da * dx ( i ) dx ( i + 1_ip ) = da * dx ( i + 1_ip ) dx ( i + 2_ip ) = da * dx ( i + 2_ip ) dx ( i + 3_ip ) = da * dx ( i + 3_ip ) dx ( i + 4_ip ) = da * dx ( i + 4_ip ) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1_ip , nincx , incx dx ( i ) = da * dx ( i ) end do end if end subroutine dscal","tags":"","loc":"proc/dscal.html"},{"title":"dswap – bspline-fortran","text":"public subroutine dswap(n, dx, incx, dy, incy) DSWAP interchanges two vectors.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Called by proc~~dswap~~CalledByGraph proc~dswap bspline_blas_module::dswap proc~dh12 bspline_defc_module::dh12 proc~dh12->proc~dswap proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dswap proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dswap proc~dlsi->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dswap proc~dwnlit->proc~dh12 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dswap proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dwnlit proc~dwnlt3->proc~dswap proc~dbndac bspline_defc_module::dbndac proc~dbndac->proc~dh12 proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfcmn->proc~dbndac proc~dhfti->proc~dh12 proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dlpdp->proc~dwnnls proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dswap ( n , dx , incx , dy , incy ) !! DSWAP interchanges two vectors. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 3_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp end do if ( n < 3_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 3_ip dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp dtemp = dx ( i + 1_ip ) dx ( i + 1_ip ) = dy ( i + 1_ip ) dy ( i + 1_ip ) = dtemp dtemp = dx ( i + 2_ip ) dx ( i + 2_ip ) = dy ( i + 2_ip ) dy ( i + 2_ip ) = dtemp end do else ! code for unequal increments or equal increments not equal ! to 1 ix = 1 iy = 1 if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dx ( ix ) dx ( ix ) = dy ( iy ) dy ( iy ) = dtemp ix = ix + incx iy = iy + incy end do end if end subroutine dswap","tags":"","loc":"proc/dswap.html"},{"title":"drotm – bspline-fortran","text":"public subroutine drotm(n, dx, incx, dy, incy, dparam) apply the modified givens transformation, H, to the 2 by n matrix Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy real(kind=wp) :: dparam (5) Called by proc~~drotm~~CalledByGraph proc~drotm bspline_blas_module::drotm proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~drotm proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~drotm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine drotm ( n , dx , incx , dy , incy , dparam ) !! apply the modified givens transformation, H, to the 2 by n matrix integer ( ip ) :: incx , incy , n real ( wp ) :: dparam ( 5 ), dx ( * ), dy ( * ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , w , z integer ( ip ) :: i , kx , ky , nsteps real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: two = 2.0_wp dflag = dparam ( 1 ) if ( n <= 0 . or . ( dflag + two == zero )) return if ( incx == incy . and . incx > 0 ) then nsteps = n * incx if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z * dh12 dy ( i ) = w * dh21 + z * dh22 end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w + z * dh12 dy ( i ) = w * dh21 + z end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z dy ( i ) = - w + dh22 * z end do end if else kx = 1 ky = 1 if ( incx < 0 ) kx = 1 + ( 1 - n ) * incx if ( incy < 0 ) ky = 1 + ( 1 - n ) * incy if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z * dh12 dy ( ky ) = w * dh21 + z * dh22 kx = kx + incx ky = ky + incy end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w + z * dh12 dy ( ky ) = w * dh21 + z kx = kx + incx ky = ky + incy end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z dy ( ky ) = - w + dh22 * z kx = kx + incx ky = ky + incy end do end if end if end subroutine drotm","tags":"","loc":"proc/drotm.html"},{"title":"drotmg – bspline-fortran","text":"public subroutine drotmg(dd1, dd2, dx1, dy1, dparam) construct the modified givens transformation matrix H Arguments Type Intent Optional Attributes Name real(kind=wp) :: dd1 real(kind=wp) :: dd2 real(kind=wp) :: dx1 real(kind=wp) :: dy1 real(kind=wp) :: dparam (5) Called by proc~~drotmg~~CalledByGraph proc~drotmg bspline_blas_module::drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~drotmg proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~drotmg proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine drotmg ( dd1 , dd2 , dx1 , dy1 , dparam ) !! construct the modified givens transformation matrix H real ( wp ) :: dd1 , dd2 , dx1 , dy1 real ( wp ) :: dparam ( 5 ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , dp1 , dp2 , dq1 , dq2 , dtemp ,& du real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: two = 2.0_wp real ( wp ), parameter :: gam = 409 6.0_wp real ( wp ), parameter :: gamsq = gam * gam !! 16777216.0_wp real ( wp ), parameter :: rgamsq = one / gamsq !! 5.9604645e-8_wp if ( dd1 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else ! case-dd1-nonnegative dp2 = dd2 * dy1 if ( dp2 == zero ) then dflag = - two dparam ( 1 ) = dflag return end if ! regular-case.. dp1 = dd1 * dx1 dq2 = dp2 * dy1 dq1 = dp1 * dx1 if ( abs ( dq1 ) > abs ( dq2 )) then dh21 = - dy1 / dx1 dh12 = dp2 / dp1 du = one - dh12 * dh21 if ( du > zero ) then dflag = zero dd1 = dd1 / du dd2 = dd2 / du dx1 = dx1 * du else ! this code path if here for safety. we do not expect this ! condition to ever hold except in edge cases with rounding ! errors. see doi: 10.1145/355841.355847 dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero end if else if ( dq2 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else dflag = one dh11 = dp1 / dp2 dh22 = dx1 / dy1 du = one + dh11 * dh22 dtemp = dd2 / du dd2 = dd1 / du dd1 = dtemp dx1 = dy1 * du end if end if ! procedure..scale-check if ( dd1 /= zero ) then do while (( dd1 <= rgamsq ) . or . ( dd1 >= gamsq )) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( dd1 <= rgamsq ) then dd1 = dd1 * gam ** 2 dx1 = dx1 / gam dh11 = dh11 / gam dh12 = dh12 / gam else dd1 = dd1 / gam ** 2 dx1 = dx1 * gam dh11 = dh11 * gam dh12 = dh12 * gam end if enddo end if if ( dd2 /= zero ) then do while ( ( abs ( dd2 ) <= rgamsq ) . or . ( abs ( dd2 ) >= gamsq ) ) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( abs ( dd2 ) <= rgamsq ) then dd2 = dd2 * gam ** 2 dh21 = dh21 / gam dh22 = dh22 / gam else dd2 = dd2 / gam ** 2 dh21 = dh21 * gam dh22 = dh22 * gam end if end do end if end if if ( dflag < zero ) then dparam ( 2 ) = dh11 dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 dparam ( 5 ) = dh22 else if ( dflag == zero ) then dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 else dparam ( 2 ) = dh11 dparam ( 5 ) = dh22 end if dparam ( 1 ) = dflag end subroutine drotmg","tags":"","loc":"proc/drotmg.html"},{"title":"status_ok – bspline-fortran","text":"private elemental function status_ok(me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. If the class is initialized using a function constructor, then\nthis is the only way to know if it was properly initialized,\nsince those are pure functions with not output iflag arguments. If status_ok=.false. , then the error message can be\nobtained from the get_bspline_status_message routine. Note: after an error condition, the clear_bspline_flag routine\ncan be called to reset the iflag to 0. Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical Source Code elemental function status_ok ( me ) result ( ok ) implicit none class ( bspline_class ), intent ( in ) :: me logical :: ok ok = ( me % iflag == 0_ip ) end function status_ok","tags":"","loc":"proc/status_ok.html"},{"title":"get_bspline_status_message – bspline-fortran","text":"private pure function get_bspline_status_message(me, iflag) result(msg) Get the status message from a bspline_class routine call. If iflag is not included, then the one in the class is used (which\ncorresponds to the last routine called.)\nOtherwise, it will convert the\ninput iflag argument into the appropriate message. This is a wrapper for get_status_message . Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag Calls proc~~get_bspline_status_message~~CallsGraph proc~get_bspline_status_message bspline_oo_module::bspline_class%get_bspline_status_message proc~get_status_message bspline_sub_module::get_status_message proc~get_bspline_status_message->proc~get_status_message Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function get_bspline_status_message ( me , iflag ) result ( msg ) implicit none class ( bspline_class ), intent ( in ) :: me character ( len = :), allocatable :: msg !! status message associated with the flag integer ( ip ), intent ( in ), optional :: iflag !! the corresponding status code if ( present ( iflag )) then msg = get_status_message ( iflag ) else msg = get_status_message ( me % iflag ) end if end function get_bspline_status_message","tags":"","loc":"proc/get_bspline_status_message.html"},{"title":"size_1d – bspline-fortran","text":"private pure function size_1d(me) result(s) Actual size of a bspline_1d structure in bits. Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_1d ( me ) result ( s ) implicit none class ( bspline_1d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 2_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) end function size_1d","tags":"","loc":"proc/size_1d.html"},{"title":"size_2d – bspline-fortran","text":"private pure function size_2d(me) result(s) Actual size of a bspline_2d structure in bits. Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_2d ( me ) result ( s ) implicit none class ( bspline_2d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 6_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) end function size_2d","tags":"","loc":"proc/size_2d.html"},{"title":"size_3d – bspline-fortran","text":"private pure function size_3d(me) result(s) Actual size of a bspline_3d structure in bits. Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_3d ( me ) result ( s ) implicit none class ( bspline_3d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 10_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) end function size_3d","tags":"","loc":"proc/size_3d.html"},{"title":"size_4d – bspline-fortran","text":"private pure function size_4d(me) result(s) Actual size of a bspline_4d structure in bits. Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_4d ( me ) result ( s ) implicit none class ( bspline_4d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 14_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) end function size_4d","tags":"","loc":"proc/size_4d.html"},{"title":"size_5d – bspline-fortran","text":"private pure function size_5d(me) result(s) Actual size of a bspline_5d structure in bits. Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_5d ( me ) result ( s ) implicit none class ( bspline_5d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 18_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) end function size_5d","tags":"","loc":"proc/size_5d.html"},{"title":"size_6d – bspline-fortran","text":"private pure function size_6d(me) result(s) Actual size of a bspline_6d structure in bits. Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_6d ( me ) result ( s ) implicit none class ( bspline_6d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 22_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) * & size ( me % bcoef , 6 , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % ts )) s = s + real_size * size ( me % ts , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) * & size ( me % work_val_1 , 5_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) * & size ( me % work_val_2 , 4_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) * & size ( me % work_val_3 , 3_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , 1_ip , kind = ip ) * & size ( me % work_val_4 , 2_ip , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) if ( allocated ( me % work_val_6 )) s = s + real_size * size ( me % work_val_6 , kind = ip ) end function size_6d","tags":"","loc":"proc/size_6d.html"},{"title":"bspline_1d_constructor_empty – bspline-fortran","text":"private pure elemental function bspline_1d_constructor_empty() result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) Called by proc~~bspline_1d_constructor_empty~~CalledByGraph proc~bspline_1d_constructor_empty bspline_oo_module::bspline_1d_constructor_empty interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental function bspline_1d_constructor_empty () result ( me ) implicit none type ( bspline_1d ) :: me end function bspline_1d_constructor_empty","tags":"","loc":"proc/bspline_1d_constructor_empty.html"},{"title":"bspline_1d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_1d_constructor_auto_knots(x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) Calls proc~~bspline_1d_constructor_auto_knots~~CallsGraph proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots->interface~db1ink proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_auto_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_1d_constructor_auto_knots~~CalledByGraph proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_1d_constructor_auto_knots ( x , fcn , kx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_auto_knots ( me , x , fcn , kx , me % iflag , extrap ) end function bspline_1d_constructor_auto_knots","tags":"","loc":"proc/bspline_1d_constructor_auto_knots.html"},{"title":"bspline_1d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_1d_constructor_specify_knots(x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) Calls proc~~bspline_1d_constructor_specify_knots~~CallsGraph proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_specify_knots->interface~db1ink proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_specify_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_1d_constructor_specify_knots~~CalledByGraph proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_1d_constructor_specify_knots ( x , fcn , kx , tx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_specify_knots ( me , x , fcn , kx , tx , me % iflag , extrap ) end function bspline_1d_constructor_specify_knots","tags":"","loc":"proc/bspline_1d_constructor_specify_knots.html"},{"title":"bspline_2d_constructor_empty – bspline-fortran","text":"private elemental function bspline_2d_constructor_empty() result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) Called by proc~~bspline_2d_constructor_empty~~CalledByGraph proc~bspline_2d_constructor_empty bspline_oo_module::bspline_2d_constructor_empty interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_2d_constructor_empty () result ( me ) implicit none type ( bspline_2d ) :: me end function bspline_2d_constructor_empty","tags":"","loc":"proc/bspline_2d_constructor_empty.html"},{"title":"bspline_2d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_2d_constructor_auto_knots(x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) Calls proc~~bspline_2d_constructor_auto_knots~~CallsGraph proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_auto_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_2d_constructor_auto_knots~~CalledByGraph proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_2d_constructor_auto_knots ( x , y , fcn , kx , ky , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , me % iflag , extrap ) end function bspline_2d_constructor_auto_knots","tags":"","loc":"proc/bspline_2d_constructor_auto_knots.html"},{"title":"bspline_2d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_2d_constructor_specify_knots(x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) Calls proc~~bspline_2d_constructor_specify_knots~~CallsGraph proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_specify_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_specify_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_2d_constructor_specify_knots~~CalledByGraph proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_2d_constructor_specify_knots ( x , y , fcn , kx , ky , tx , ty , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , me % iflag , extrap ) end function bspline_2d_constructor_specify_knots","tags":"","loc":"proc/bspline_2d_constructor_specify_knots.html"},{"title":"bspline_3d_constructor_empty – bspline-fortran","text":"private elemental function bspline_3d_constructor_empty() result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) Called by proc~~bspline_3d_constructor_empty~~CalledByGraph proc~bspline_3d_constructor_empty bspline_oo_module::bspline_3d_constructor_empty interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_3d_constructor_empty () result ( me ) implicit none type ( bspline_3d ) :: me end function bspline_3d_constructor_empty","tags":"","loc":"proc/bspline_3d_constructor_empty.html"},{"title":"bspline_3d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_3d_constructor_auto_knots(x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) Calls proc~~bspline_3d_constructor_auto_knots~~CallsGraph proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_auto_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_3d_constructor_auto_knots~~CalledByGraph proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_3d_constructor_auto_knots ( x , y , z , fcn , kx , ky , kz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , me % iflag , extrap ) end function bspline_3d_constructor_auto_knots","tags":"","loc":"proc/bspline_3d_constructor_auto_knots.html"},{"title":"bspline_3d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_3d_constructor_specify_knots(x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) Calls proc~~bspline_3d_constructor_specify_knots~~CallsGraph proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_specify_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_specify_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_3d_constructor_specify_knots~~CalledByGraph proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_3d_constructor_specify_knots ( x , y , z , fcn , kx , ky , kz , tx , ty , tz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , me % iflag , extrap ) end function bspline_3d_constructor_specify_knots","tags":"","loc":"proc/bspline_3d_constructor_specify_knots.html"},{"title":"bspline_4d_constructor_empty – bspline-fortran","text":"private elemental function bspline_4d_constructor_empty() result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) Called by proc~~bspline_4d_constructor_empty~~CalledByGraph proc~bspline_4d_constructor_empty bspline_oo_module::bspline_4d_constructor_empty interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_4d_constructor_empty () result ( me ) implicit none type ( bspline_4d ) :: me end function bspline_4d_constructor_empty","tags":"","loc":"proc/bspline_4d_constructor_empty.html"},{"title":"bspline_4d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_4d_constructor_auto_knots(x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) Calls proc~~bspline_4d_constructor_auto_knots~~CallsGraph proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_auto_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_4d_constructor_auto_knots~~CalledByGraph proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_4d_constructor_auto_knots ( x , y , z , q , fcn , kx , ky , kz , kq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , me % iflag , extrap ) end function bspline_4d_constructor_auto_knots","tags":"","loc":"proc/bspline_4d_constructor_auto_knots.html"},{"title":"bspline_4d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_4d_constructor_specify_knots(x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) Calls proc~~bspline_4d_constructor_specify_knots~~CallsGraph proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_specify_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_specify_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_4d_constructor_specify_knots~~CalledByGraph proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_4d_constructor_specify_knots ( x , y , z , q , fcn , kx , ky , kz , kq ,& tx , ty , tz , tq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_specify_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , tx , ty , tz , tq , me % iflag , extrap ) end function bspline_4d_constructor_specify_knots","tags":"","loc":"proc/bspline_4d_constructor_specify_knots.html"},{"title":"bspline_5d_constructor_empty – bspline-fortran","text":"private elemental function bspline_5d_constructor_empty() result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) Called by proc~~bspline_5d_constructor_empty~~CalledByGraph proc~bspline_5d_constructor_empty bspline_oo_module::bspline_5d_constructor_empty interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_5d_constructor_empty () result ( me ) implicit none type ( bspline_5d ) :: me end function bspline_5d_constructor_empty","tags":"","loc":"proc/bspline_5d_constructor_empty.html"},{"title":"bspline_5d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_5d_constructor_auto_knots(x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) Calls proc~~bspline_5d_constructor_auto_knots~~CallsGraph proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_auto_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_5d_constructor_auto_knots~~CalledByGraph proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_5d_constructor_auto_knots ( x , y , z , q , r , fcn , kx , ky , kz , kq , kr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , me % iflag , extrap ) end function bspline_5d_constructor_auto_knots","tags":"","loc":"proc/bspline_5d_constructor_auto_knots.html"},{"title":"bspline_5d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_5d_constructor_specify_knots(x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) Calls proc~~bspline_5d_constructor_specify_knots~~CallsGraph proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_specify_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_specify_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_5d_constructor_specify_knots~~CalledByGraph proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_5d_constructor_specify_knots ( x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_specify_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , tx , ty , tz , tq , tr , me % iflag , extrap ) end function bspline_5d_constructor_specify_knots","tags":"","loc":"proc/bspline_5d_constructor_specify_knots.html"},{"title":"bspline_6d_constructor_empty – bspline-fortran","text":"private elemental function bspline_6d_constructor_empty() result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) Called by proc~~bspline_6d_constructor_empty~~CalledByGraph proc~bspline_6d_constructor_empty bspline_oo_module::bspline_6d_constructor_empty interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_6d_constructor_empty () result ( me ) implicit none type ( bspline_6d ) :: me end function bspline_6d_constructor_empty","tags":"","loc":"proc/bspline_6d_constructor_empty.html"},{"title":"bspline_6d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_6d_constructor_auto_knots(x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Calls proc~~bspline_6d_constructor_auto_knots~~CallsGraph proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_auto_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_6d_constructor_auto_knots~~CalledByGraph proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_6d_constructor_auto_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn , kx , ky , kz , kq , kr , ks , me % iflag , extrap ) end function bspline_6d_constructor_auto_knots","tags":"","loc":"proc/bspline_6d_constructor_auto_knots.html"},{"title":"bspline_6d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_6d_constructor_specify_knots(x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Calls proc~~bspline_6d_constructor_specify_knots~~CallsGraph proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_specify_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_specify_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_6d_constructor_specify_knots~~CalledByGraph proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_6d_constructor_specify_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , me % iflag , extrap ) end function bspline_6d_constructor_specify_knots","tags":"","loc":"proc/bspline_6d_constructor_specify_knots.html"},{"title":"clear_bspline_flag – bspline-fortran","text":"private elemental subroutine clear_bspline_flag(me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Source Code elemental subroutine clear_bspline_flag ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % iflag = 0_ip end subroutine clear_bspline_flag","tags":"","loc":"proc/clear_bspline_flag.html"},{"title":"destroy_base – bspline-fortran","text":"private pure subroutine destroy_base(me) Destructor for contents of the base bspline_class class.\n(this routine is called by the extended classes). Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Called by proc~~destroy_base~~CalledByGraph proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~destroy_1d->proc~destroy_base proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~destroy_2d->proc~destroy_base proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~destroy_3d->proc~destroy_base proc~finalize_1d bspline_oo_module::finalize_1d proc~finalize_1d->proc~destroy_1d proc~finalize_2d bspline_oo_module::finalize_2d proc~finalize_2d->proc~destroy_2d proc~finalize_3d bspline_oo_module::finalize_3d proc~finalize_3d->proc~destroy_3d proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->proc~destroy_1d proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~destroy_1d proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~destroy_2d proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~destroy_2d proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~destroy_3d proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~destroy_3d proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_base ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % inbvx = 1_ip me % iflag = 1_ip me % initialized = . false . me % extrap = . false . end subroutine destroy_base","tags":"","loc":"proc/destroy_base.html"},{"title":"destroy_1d – bspline-fortran","text":"private pure subroutine destroy_1d(me) Destructor for bspline_1d class. Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me Calls proc~~destroy_1d~~CallsGraph proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~destroy_1d~~CalledByGraph proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~finalize_1d bspline_oo_module::finalize_1d proc~finalize_1d->proc~destroy_1d proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->proc~destroy_1d proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~destroy_1d proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_1d ( me ) implicit none class ( bspline_1d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % kx = 0_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) end subroutine destroy_1d","tags":"","loc":"proc/destroy_1d.html"},{"title":"destroy_2d – bspline-fortran","text":"private pure subroutine destroy_2d(me) Destructor for bspline_2d class. Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me Calls proc~~destroy_2d~~CallsGraph proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~destroy_2d~~CalledByGraph proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~finalize_2d bspline_oo_module::finalize_2d proc~finalize_2d->proc~destroy_2d proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~destroy_2d proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~destroy_2d proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_2d ( me ) implicit none class ( bspline_2d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % kx = 0_ip me % ky = 0_ip me % inbvy = 1_ip me % iloy = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) end subroutine destroy_2d","tags":"","loc":"proc/destroy_2d.html"},{"title":"destroy_3d – bspline-fortran","text":"private pure subroutine destroy_3d(me) Destructor for bspline_3d class. Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me Calls proc~~destroy_3d~~CallsGraph proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~destroy_3d~~CalledByGraph proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~finalize_3d bspline_oo_module::finalize_3d proc~finalize_3d->proc~destroy_3d proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~destroy_3d proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~destroy_3d proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_3d ( me ) implicit none class ( bspline_3d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % iloy = 1_ip me % iloz = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) end subroutine destroy_3d","tags":"","loc":"proc/destroy_3d.html"},{"title":"destroy_4d – bspline-fortran","text":"private pure subroutine destroy_4d(me) Destructor for bspline_4d class. Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me Called by proc~~destroy_4d~~CalledByGraph proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~finalize_4d bspline_oo_module::finalize_4d proc~finalize_4d->proc~destroy_4d proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~destroy_4d proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~destroy_4d proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_4d ( me ) implicit none class ( bspline_4d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) end subroutine destroy_4d","tags":"","loc":"proc/destroy_4d.html"},{"title":"destroy_5d – bspline-fortran","text":"private pure subroutine destroy_5d(me) Destructor for bspline_5d class. Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me Called by proc~~destroy_5d~~CalledByGraph proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~finalize_5d bspline_oo_module::finalize_5d proc~finalize_5d->proc~destroy_5d proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~destroy_5d proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~destroy_5d proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_5d ( me ) implicit none class ( bspline_5d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) end subroutine destroy_5d","tags":"","loc":"proc/destroy_5d.html"},{"title":"destroy_6d – bspline-fortran","text":"private pure subroutine destroy_6d(me) Destructor for bspline_6d class. Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me Called by proc~~destroy_6d~~CalledByGraph proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~finalize_6d bspline_oo_module::finalize_6d proc~finalize_6d->proc~destroy_6d proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~destroy_6d proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~destroy_6d proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_6d ( me ) implicit none class ( bspline_6d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % ns = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % ks = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % inbvs = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip me % ilos = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % ts )) deallocate ( me % ts ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) if ( allocated ( me % work_val_6 )) deallocate ( me % work_val_6 ) end subroutine destroy_6d","tags":"","loc":"proc/destroy_6d.html"},{"title":"finalize_1d – bspline-fortran","text":"private pure elemental subroutine finalize_1d(me) Finalizer for bspline_1d class. Just a wrapper for destroy_1d . Arguments Type Intent Optional Attributes Name type( bspline_1d ), intent(inout) :: me Calls proc~~finalize_1d~~CallsGraph proc~finalize_1d bspline_oo_module::finalize_1d proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~finalize_1d->proc~destroy_1d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_1d ( me ) type ( bspline_1d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_1d","tags":"","loc":"proc/finalize_1d.html"},{"title":"finalize_2d – bspline-fortran","text":"private pure elemental subroutine finalize_2d(me) Finalizer for bspline_2d class. Just a wrapper for destroy_2d . Arguments Type Intent Optional Attributes Name type( bspline_2d ), intent(inout) :: me Calls proc~~finalize_2d~~CallsGraph proc~finalize_2d bspline_oo_module::finalize_2d proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~finalize_2d->proc~destroy_2d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_2d ( me ) type ( bspline_2d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_2d","tags":"","loc":"proc/finalize_2d.html"},{"title":"finalize_3d – bspline-fortran","text":"private pure elemental subroutine finalize_3d(me) Finalizer for bspline_3d class. Just a wrapper for destroy_3d . Arguments Type Intent Optional Attributes Name type( bspline_3d ), intent(inout) :: me Calls proc~~finalize_3d~~CallsGraph proc~finalize_3d bspline_oo_module::finalize_3d proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~finalize_3d->proc~destroy_3d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_3d ( me ) type ( bspline_3d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_3d","tags":"","loc":"proc/finalize_3d.html"},{"title":"finalize_4d – bspline-fortran","text":"private pure elemental subroutine finalize_4d(me) Finalizer for bspline_4d class. Just a wrapper for destroy_4d . Arguments Type Intent Optional Attributes Name type( bspline_4d ), intent(inout) :: me Calls proc~~finalize_4d~~CallsGraph proc~finalize_4d bspline_oo_module::finalize_4d proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~finalize_4d->proc~destroy_4d Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_4d ( me ) type ( bspline_4d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_4d","tags":"","loc":"proc/finalize_4d.html"},{"title":"finalize_5d – bspline-fortran","text":"private pure elemental subroutine finalize_5d(me) Finalizer for bspline_5d class. Just a wrapper for destroy_5d . Arguments Type Intent Optional Attributes Name type( bspline_5d ), intent(inout) :: me Calls proc~~finalize_5d~~CallsGraph proc~finalize_5d bspline_oo_module::finalize_5d proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~finalize_5d->proc~destroy_5d Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_5d ( me ) type ( bspline_5d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_5d","tags":"","loc":"proc/finalize_5d.html"},{"title":"finalize_6d – bspline-fortran","text":"private pure elemental subroutine finalize_6d(me) Finalizer for bspline_6d class. Just a wrapper for destroy_6d . Arguments Type Intent Optional Attributes Name type( bspline_6d ), intent(inout) :: me Calls proc~~finalize_6d~~CallsGraph proc~finalize_6d bspline_oo_module::finalize_6d proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~finalize_6d->proc~destroy_6d Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_6d ( me ) type ( bspline_6d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_6d","tags":"","loc":"proc/finalize_6d.html"},{"title":"set_extrap_flag – bspline-fortran","text":"private pure subroutine set_extrap_flag(me, extrap) Sets the extrap flag in the class. Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me logical, intent(in), optional :: extrap if not present, then False is used Called by proc~~set_extrap_flag~~CalledByGraph proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine set_extrap_flag ( me , extrap ) implicit none class ( bspline_class ), intent ( inout ) :: me logical , intent ( in ), optional :: extrap !! if not present, then False is used if ( present ( extrap )) then me % extrap = extrap else me % extrap = . false . end if end subroutine set_extrap_flag","tags":"","loc":"proc/set_extrap_flag.html"},{"title":"initialize_1d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_1d_auto_knots(me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_1d_auto_knots~~CallsGraph proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots->interface~db1ink proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_auto_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_1d_auto_knots~~CalledByGraph proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_1d_auto_knots ( me , x , fcn , kx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) iknot = 0_ip !knot sequence chosen by db1ink call db1ink ( x , nx , fcn , kx , iknot , me % tx , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_auto_knots","tags":"","loc":"proc/initialize_1d_auto_knots.html"},{"title":"initialize_1d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_1d_specify_knots(me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_1d_specify_knots~~CallsGraph proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_specify_knots->interface~db1ink proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_specify_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_1d_specify_knots~~CalledByGraph proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_1d_specify_knots ( me , x , fcn , kx , tx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx , iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) me % tx = tx call db1ink ( x , nx , fcn , kx , 1_ip , me % tx , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_specify_knots","tags":"","loc":"proc/initialize_1d_specify_knots.html"},{"title":"evaluate_1d – bspline-fortran","text":"private pure subroutine evaluate_1d(me, xval, idx, f, iflag) Evaluate a bspline_1d interpolate. This is a wrapper for db1val . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db1val ) Calls proc~~evaluate_1d~~CallsGraph proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d interface~db1val bspline_sub_module::db1val proc~evaluate_1d->interface~db1val proc~db1val_alt bspline_sub_module::db1val_alt interface~db1val->proc~db1val_alt proc~db1val_default bspline_sub_module::db1val_default interface~db1val->proc~db1val_default proc~check_value bspline_sub_module::check_value proc~db1val_alt->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt->proc~dbvalu proc~db1val_default->proc~check_value proc~db1val_default->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_1d ( me , xval , idx , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1val]]) if ( me % initialized ) then call db1val ( xval , idx , me % tx , me % nx , me % kx , me % bcoef , f , iflag ,& me % inbvx , me % work_val_1 , extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_1d","tags":"","loc":"proc/evaluate_1d.html"},{"title":"integral_1d – bspline-fortran","text":"private pure subroutine integral_1d(me, x1, x2, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1sqad . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(out) :: f integral of the b-spline over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) Calls proc~~integral_1d~~CallsGraph proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~db1sqad bspline_sub_module::db1sqad proc~integral_1d->proc~db1sqad proc~dbsqad bspline_sub_module::dbsqad proc~db1sqad->proc~dbsqad proc~dbvalu bspline_sub_module::dbvalu proc~dbsqad->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbsqad->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine integral_1d ( me , x1 , x2 , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( out ) :: f !! integral of the b-spline over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1sqad ( me % tx , me % bcoef , me % nx , me % kx , x1 , x2 , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine integral_1d","tags":"","loc":"proc/integral_1d.html"},{"title":"fintegral_1d – bspline-fortran","text":"private subroutine fintegral_1d(me, fun, idx, x1, x2, tol, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1fqad . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv) integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(in) :: tol desired accuracy for the quadrature real(kind=wp), intent(out) :: f integral of bf(x) over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) Calls proc~~fintegral_1d~~CallsGraph proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~db1fqad bspline_sub_module::db1fqad proc~fintegral_1d->proc~db1fqad proc~dbfqad bspline_sub_module::dbfqad proc~db1fqad->proc~dbfqad proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dintrv bspline_sub_module::dintrv proc~dbfqad->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap proc~dbvalu->proc~dintrv Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine fintegral_1d ( me , fun , idx , x1 , x2 , tol , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv)` integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature real ( wp ), intent ( out ) :: f !! integral of `bf(x)` over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1fqad ( fun , me % tx , me % bcoef , me % nx , me % kx , idx , x1 , x2 , tol , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine fintegral_1d","tags":"","loc":"proc/fintegral_1d.html"},{"title":"initialize_2d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_2d_auto_knots(me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_2d_auto_knots~~CallsGraph proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_auto_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_2d_auto_knots~~CalledByGraph proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) iknot = 0_ip !knot sequence chosen by db2ink call db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , me % tx , me % ty , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_auto_knots","tags":"","loc":"proc/initialize_2d_auto_knots.html"},{"title":"initialize_2d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_2d_specify_knots(me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_2d_specify_knots~~CallsGraph proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_specify_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_specify_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_2d_specify_knots~~CalledByGraph proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) me % tx = tx me % ty = ty call db2ink ( x , nx , y , ny , fcn , kx , ky , 1_ip , me % tx , me % ty , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_specify_knots","tags":"","loc":"proc/initialize_2d_specify_knots.html"},{"title":"evaluate_2d – bspline-fortran","text":"private pure subroutine evaluate_2d(me, xval, yval, idx, idy, f, iflag) Evaluate a bspline_2d interpolate. This is a wrapper for db2val . Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db2val ) Calls proc~~evaluate_2d~~CallsGraph proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~db2val bspline_sub_module::db2val proc~evaluate_2d->proc~db2val proc~check_value bspline_sub_module::check_value proc~db2val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db2val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_2d ( me , xval , yval , idx , idy , f , iflag ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2val]]) if ( me % initialized ) then call db2val ( xval , yval ,& idx , idy ,& me % tx , me % ty ,& me % nx , me % ny ,& me % kx , me % ky ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % iloy ,& me % work_val_1 , me % work_val_2 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_2d","tags":"","loc":"proc/evaluate_2d.html"},{"title":"initialize_3d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_3d_auto_knots(me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_3d_auto_knots~~CallsGraph proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_auto_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_3d_auto_knots~~CalledByGraph proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) iknot = 0_ip !knot sequence chosen by db3ink call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& iknot ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_auto_knots","tags":"","loc":"proc/initialize_3d_auto_knots.html"},{"title":"initialize_3d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_3d_specify_knots(me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_3d_specify_knots~~CallsGraph proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_specify_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_specify_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_3d_specify_knots~~CalledByGraph proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) me % tx = tx me % ty = ty me % tz = tz call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& 1_ip ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_specify_knots","tags":"","loc":"proc/initialize_3d_specify_knots.html"},{"title":"evaluate_3d – bspline-fortran","text":"private pure subroutine evaluate_3d(me, xval, yval, zval, idx, idy, idz, f, iflag) Evaluate a bspline_3d interpolate. This is a wrapper for db3val . Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db3val ) Calls proc~~evaluate_3d~~CallsGraph proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~db3val bspline_sub_module::db3val proc~evaluate_3d->proc~db3val proc~check_value bspline_sub_module::check_value proc~db3val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db3val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db3val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_3d ( me , xval , yval , zval , idx , idy , idz , f , iflag ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3val]]) if ( me % initialized ) then call db3val ( xval , yval , zval ,& idx , idy , idz ,& me % tx , me % ty , me % tz ,& me % nx , me % ny , me % nz ,& me % kx , me % ky , me % kz ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz ,& me % iloy , me % iloz ,& me % work_val_1 , me % work_val_2 , me % work_val_3 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_3d","tags":"","loc":"proc/evaluate_3d.html"},{"title":"initialize_4d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_4d_auto_knots(me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_4d_auto_knots~~CallsGraph proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_auto_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_4d_auto_knots~~CalledByGraph proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) iknot = 0_ip !knot sequence chosen by db4ink call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_auto_knots","tags":"","loc":"proc/initialize_4d_auto_knots.html"},{"title":"initialize_4d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_4d_specify_knots(me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_4d_specify_knots~~CallsGraph proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_specify_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_specify_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_4d_specify_knots~~CalledByGraph proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_4d_specify_knots ( me , x , y , z , q , fcn ,& kx , ky , kz , kq , tx , ty , tz , tq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_specify_knots","tags":"","loc":"proc/initialize_4d_specify_knots.html"},{"title":"evaluate_4d – bspline-fortran","text":"private pure subroutine evaluate_4d(me, xval, yval, zval, qval, idx, idy, idz, idq, f, iflag) Evaluate a bspline_4d interpolate. This is a wrapper for db4val . Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db4val ) Calls proc~~evaluate_4d~~CallsGraph proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~db4val bspline_sub_module::db4val proc~evaluate_4d->proc~db4val proc~check_value bspline_sub_module::check_value proc~db4val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db4val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db4val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_4d ( me , xval , yval , zval , qval , idx , idy , idz , idq , f , iflag ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4val]]) if ( me % initialized ) then call db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& me % tx , me % ty , me % tz , me % tq ,& me % nx , me % ny , me % nz , me % nq ,& me % kx , me % ky , me % kz , me % kq ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq ,& me % iloy , me % iloz , me % iloq ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_4d","tags":"","loc":"proc/evaluate_4d.html"},{"title":"initialize_5d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_5d_auto_knots(me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_5d_auto_knots~~CallsGraph proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_auto_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_5d_auto_knots~~CalledByGraph proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) iknot = 0_ip !knot sequence chosen by db5ink call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_auto_knots","tags":"","loc":"proc/initialize_5d_auto_knots.html"},{"title":"initialize_5d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_5d_specify_knots(me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_5d_specify_knots~~CallsGraph proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_specify_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_specify_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_5d_specify_knots~~CalledByGraph proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_5d_specify_knots ( me , x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_specify_knots","tags":"","loc":"proc/initialize_5d_specify_knots.html"},{"title":"evaluate_5d – bspline-fortran","text":"private pure subroutine evaluate_5d(me, xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, f, iflag) Evaluate a bspline_5d interpolate. This is a wrapper for db5val . Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db5val ) Calls proc~~evaluate_5d~~CallsGraph proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~db5val bspline_sub_module::db5val proc~evaluate_5d->proc~db5val proc~check_value bspline_sub_module::check_value proc~db5val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db5val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db5val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_5d ( me , xval , yval , zval , qval , rval , idx , idy , idz , idq , idr , f , iflag ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5val]]) if ( me % initialized ) then call db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % nx , me % ny , me % nz , me % nq , me % nr ,& me % kx , me % ky , me % kz , me % kq , me % kr ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr ,& me % iloy , me % iloz , me % iloq , me % ilor ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_5d","tags":"","loc":"proc/evaluate_5d.html"},{"title":"initialize_6d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_6d_auto_knots(me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_6d_auto_knots~~CallsGraph proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_auto_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_6d_auto_knots~~CalledByGraph proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) iknot = 0_ip !knot sequence chosen by db6ink call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_auto_knots","tags":"","loc":"proc/initialize_6d_auto_knots.html"},{"title":"initialize_6d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_6d_specify_knots(me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_6d_specify_knots~~CallsGraph proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_specify_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_specify_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_6d_specify_knots~~CalledByGraph proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& ns = ns , ks = ks , ts = ts ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr me % ts = ts call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_specify_knots","tags":"","loc":"proc/initialize_6d_specify_knots.html"},{"title":"evaluate_6d – bspline-fortran","text":"private pure subroutine evaluate_6d(me, xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, f, iflag) Evaluate a bspline_6d interpolate. This is a wrapper for db6val . Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db6val ) Calls proc~~evaluate_6d~~CallsGraph proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~db6val bspline_sub_module::db6val proc~evaluate_6d->proc~db6val proc~check_value bspline_sub_module::check_value proc~db6val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db6val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db6val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_6d ( me , xval , yval , zval , qval , rval , sval , idx , idy , idz , idq , idr , ids , f , iflag ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6val]]) if ( me % initialized ) then call db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % nx , me % ny , me % nz , me % nq , me % nr , me % ns ,& me % kx , me % ky , me % kz , me % kq , me % kr , me % ks ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr , me % inbvs ,& me % iloy , me % iloz , me % iloq , me % ilor , me % ilos ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 , me % work_val_6 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_6d","tags":"","loc":"proc/evaluate_6d.html"},{"title":"check_knot_vectors_sizes – bspline-fortran","text":"private pure subroutine check_knot_vectors_sizes(nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag) Error checks for the user-specified knot vector sizes. Note If more than one is the wrong size, then the iflag error code will\n correspond to the one with the highest rank. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts integer(kind=ip), intent(out) :: iflag 0 if everything is OK Called by proc~~check_knot_vectors_sizes~~CalledByGraph proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine check_knot_vectors_sizes ( nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag ) implicit none integer ( ip ), intent ( in ), optional :: nx integer ( ip ), intent ( in ), optional :: ny integer ( ip ), intent ( in ), optional :: nz integer ( ip ), intent ( in ), optional :: nq integer ( ip ), intent ( in ), optional :: nr integer ( ip ), intent ( in ), optional :: ns integer ( ip ), intent ( in ), optional :: kx integer ( ip ), intent ( in ), optional :: ky integer ( ip ), intent ( in ), optional :: kz integer ( ip ), intent ( in ), optional :: kq integer ( ip ), intent ( in ), optional :: kr integer ( ip ), intent ( in ), optional :: ks real ( wp ), dimension (:), intent ( in ), optional :: tx real ( wp ), dimension (:), intent ( in ), optional :: ty real ( wp ), dimension (:), intent ( in ), optional :: tz real ( wp ), dimension (:), intent ( in ), optional :: tq real ( wp ), dimension (:), intent ( in ), optional :: tr real ( wp ), dimension (:), intent ( in ), optional :: ts integer ( ip ), intent ( out ) :: iflag !! 0 if everything is OK iflag = 0_ip if ( present ( nx ) . and . present ( kx ) . and . present ( tx )) then if ( size ( tx , kind = ip ) /= ( nx + kx )) then iflag = 501_ip ! tx is not the correct size (nx+kx) end if end if if ( present ( ny ) . and . present ( ky ) . and . present ( ty )) then if ( size ( ty , kind = ip ) /= ( ny + ky )) then iflag = 502_ip ! ty is not the correct size (ny+ky) end if end if if ( present ( nz ) . and . present ( kz ) . and . present ( tz )) then if ( size ( tz , kind = ip ) /= ( nz + kz )) then iflag = 503_ip ! tz is not the correct size (nz+kz) end if end if if ( present ( nq ) . and . present ( kq ) . and . present ( tq )) then if ( size ( tq , kind = ip ) /= ( nq + kq )) then iflag = 504_ip ! tq is not the correct size (nq+kq) end if end if if ( present ( nr ) . and . present ( kr ) . and . present ( tr )) then if ( size ( tr , kind = ip ) /= ( nr + kr )) then iflag = 505_ip ! tr is not the correct size (nr+kr) end if end if if ( present ( ns ) . and . present ( ks ) . and . present ( ts )) then if ( size ( ts , kind = ip ) /= ( ns + ks )) then iflag = 506_ip ! ts is not the correct size (ns+ks) end if end if end subroutine check_knot_vectors_sizes","tags":"","loc":"proc/check_knot_vectors_sizes.html"},{"title":"bspline_1d – bspline-fortran","text":"public interface bspline_1d Constructor for bspline_1d Calls interface~~bspline_1d~~CallsGraph interface~bspline_1d bspline_oo_module::bspline_1d proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_empty bspline_oo_module::bspline_1d_constructor_empty interface~bspline_1d->proc~bspline_1d_constructor_empty proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots->interface~db1ink proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_auto_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~initialize_1d_specify_knots->interface~db1ink proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~destroy_1d proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d )","tags":"","loc":"interface/bspline_1d.html"},{"title":"bspline_2d – bspline-fortran","text":"public interface bspline_2d Constructor for bspline_2d Calls interface~~bspline_2d~~CallsGraph interface~bspline_2d bspline_oo_module::bspline_2d proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_empty bspline_oo_module::bspline_2d_constructor_empty interface~bspline_2d->proc~bspline_2d_constructor_empty proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_auto_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_2d_specify_knots->proc~destroy_2d proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d )","tags":"","loc":"interface/bspline_2d.html"},{"title":"bspline_3d – bspline-fortran","text":"public interface bspline_3d Constructor for bspline_3d Calls interface~~bspline_3d~~CallsGraph interface~bspline_3d bspline_oo_module::bspline_3d proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_empty bspline_oo_module::bspline_3d_constructor_empty interface~bspline_3d->proc~bspline_3d_constructor_empty proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_auto_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_3d_specify_knots->proc~destroy_3d proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d )","tags":"","loc":"interface/bspline_3d.html"},{"title":"bspline_4d – bspline-fortran","text":"public interface bspline_4d Constructor for bspline_4d Calls interface~~bspline_4d~~CallsGraph interface~bspline_4d bspline_oo_module::bspline_4d proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_empty bspline_oo_module::bspline_4d_constructor_empty interface~bspline_4d->proc~bspline_4d_constructor_empty proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_auto_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_4d_specify_knots->proc~destroy_4d proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d )","tags":"","loc":"interface/bspline_4d.html"},{"title":"bspline_5d – bspline-fortran","text":"public interface bspline_5d Constructor for bspline_5d Calls interface~~bspline_5d~~CallsGraph interface~bspline_5d bspline_oo_module::bspline_5d proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_empty bspline_oo_module::bspline_5d_constructor_empty interface~bspline_5d->proc~bspline_5d_constructor_empty proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_auto_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_5d_specify_knots->proc~destroy_5d proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d )","tags":"","loc":"interface/bspline_5d.html"},{"title":"bspline_6d – bspline-fortran","text":"public interface bspline_6d Constructor for bspline_6d Calls interface~~bspline_6d~~CallsGraph interface~bspline_6d bspline_oo_module::bspline_6d proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_empty bspline_oo_module::bspline_6d_constructor_empty interface~bspline_6d->proc~bspline_6d_constructor_empty proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_auto_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~db6ink proc~initialize_6d_specify_knots->proc~destroy_6d proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d )","tags":"","loc":"interface/bspline_6d.html"},{"title":"bspline_module – bspline-fortran","text":"Description Multidimensional (1D-6D) B-Spline interpolation of data on a regular grid.\n This module uses both the subroutine and object-oriented modules. Uses bspline_kinds_module bspline_defc_module bspline_sub_module bspline_oo_module module~~bspline_module~~UsesGraph module~bspline_module bspline_module module~bspline_defc_module bspline_defc_module module~bspline_module->module~bspline_defc_module module~bspline_kinds_module bspline_kinds_module module~bspline_module->module~bspline_kinds_module module~bspline_oo_module bspline_oo_module module~bspline_module->module~bspline_oo_module module~bspline_sub_module bspline_sub_module module~bspline_module->module~bspline_sub_module module~bspline_defc_module->module~bspline_kinds_module module~bspline_blas_module bspline_blas_module module~bspline_defc_module->module~bspline_blas_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env module~bspline_oo_module->module~bspline_kinds_module module~bspline_oo_module->module~bspline_sub_module module~bspline_oo_module->iso_fortran_env module~bspline_sub_module->module~bspline_kinds_module module~bspline_sub_module->iso_fortran_env module~bspline_blas_module->module~bspline_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses.","tags":"","loc":"module/bspline_module.html"},{"title":"bspline_defc_module – bspline-fortran","text":"defc and dfc procedures and support routines from [SLATEC](https:\n For fitting B-splines polynomials to discrete 1D data. References For a description of the B-splines and usage instructions to\n evaluate them, see: C. W. de Boor, Package for Calculating with B-Splines.\n SIAM J. Numer. Anal., p. 441, (June, 1977). For further discussion of (constrained) curve fitting using\n B-splines, see reference 2. R. J. Hanson, Constrained least squares curve fitting\n to discrete data using B-splines, a users guide,\n Report SAND78-1291, Sandia Laboratories, December\n 1978. History Dec 2022 (Jacob Williams) : Cleanup and modernization of the SLATEC routines. Note This module does not support the user-defined ip integer kind.\n It only uses the default integer kind. Todo add iflag outputs to be consistent with the rest of the library. Uses bspline_kinds_module bspline_blas_module module~~bspline_defc_module~~UsesGraph module~bspline_defc_module bspline_defc_module module~bspline_blas_module bspline_blas_module module~bspline_defc_module->module~bspline_blas_module module~bspline_kinds_module bspline_kinds_module module~bspline_defc_module->module~bspline_kinds_module module~bspline_blas_module->module~bspline_kinds_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_defc_module~~UsedByGraph module~bspline_defc_module bspline_defc_module module~bspline_module bspline_module module~bspline_module->module~bspline_defc_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial real(kind=wp), private, parameter :: drelpr = epsilon(1.0_wp) machine precision ( d1mach(4) ) Functions private function dwnlt2 (me, mend, ir, factor, tau, scale, wic) To test independence of incoming column. Read more… Arguments Type Intent Optional Attributes Name integer :: me integer :: mend integer :: ir real(kind=wp) :: factor real(kind=wp) :: tau real(kind=wp) :: scale (*) real(kind=wp) :: wic (*) Return Value logical public function dcv (xval, ndata, nconst, nord, nbkpt, bkpt, w) dcv is a companion function subprogram for dfc . The\n documentation for dfc has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval The point where the variance is desired integer, intent(in) :: ndata The number of discrete (X,Y) pairs for which dfc calculated a piece-wise polynomial curve. integer, intent(in) :: nconst The number of conditions that constrained the B-spline in dfc . integer, intent(in) :: nord The order of the B-spline used in dfc .\nThe value of NORD must satisfy 1 < NORD < 20 . Read more… integer, intent(in) :: nbkpt The number of knots in the array BKPT( ).\nThe value of NBKPT must satisfy NBKPT .GE. 2 NORD. real(kind=wp), intent(in) :: bkpt (*) The array of knots. Normally the problem\ndata interval will be included between the limits\nBKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end\nknots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT,\nare required by dfc to compute the functions used to\nfit the data. real(kind=wp) :: w (*) Real work array as used in dfc . See dfc for the required length of W( ). The contents of W( )\nmust not be modified by the user if the variance function\nis desired. Return Value real(kind=wp) Subroutines public subroutine defc (Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkpt, Mdein, Mdeout, Coeff, Lw, w) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: Ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in), dimension(ndata) :: Xdata X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in), dimension(ndata) :: Ydata Y data array. real(kind=wp), intent(in), dimension(ndata) :: Sddata Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: Nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(:) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: Mdein An integer flag, with one of two possible\nvalues (1 or 2), that directs the subprogram\naction with regard to new data points provided\nby the user: Read more… integer, intent(out) :: Mdeout An output flag that indicates the status\nof the curve fit: Read more… real(kind=wp), intent(out) :: Coeff (*) If the output value of MDEOUT=1 , this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD parameters are the B-spline coefficients.\nFor MDEOUT=2 , not enough data was processed to\nuniquely determine the B-spline coefficients.\nIn this case, and also when MDEOUT=-1 , all\nvalues of COEFF(*) are set to zero. Read more… integer, intent(in) :: Lw The amount of working storage actually\n allocated for the working array W(*) .\n This quantity is compared with the\n actual amount of storage needed in DEFC .\n Insufficient storage allocated for W(*) is\n an error. This feature was included in DEFC because misreading the storage formula\n for W(*) might very well lead to subtle\n and hard-to-find programming bugs. Read more… real(kind=wp) :: w (*) Working Array.\nIts length is specified as an input parameter\nin LW as noted above. The contents of W(*) must not be modified by the user between calls\nto DEFC with values of MDEIN=1,2,2,... .\nThe first (NBKPT-NORD+3)*(NORD+1) entries of W(*) are acceptable as direct input to DFC for an \"old problem\" only when MDEOUT=1 or 2 . private subroutine defcmn (Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkptin, Mdein, Mdeout, Coeff, Bf, Xtemp, Ptemp, Bkpt, g, Mdg, w, Mdw, Lw) This is a companion subprogram to DEFC .\n This subprogram does weighted least squares fitting of data by\n B-spline curves.\n The documentation for DEFC has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name integer :: Ndata real(kind=wp) :: Xdata (*) real(kind=wp) :: Ydata (*) real(kind=wp) :: Sddata (*) integer :: Nord integer :: Nbkpt real(kind=wp) :: Bkptin (*) integer :: Mdein integer :: Mdeout real(kind=wp) :: Coeff (*) real(kind=wp) :: Bf (Nord,*) real(kind=wp) :: Xtemp (*) real(kind=wp) :: Ptemp (*) real(kind=wp) :: Bkpt (*) real(kind=wp) :: g (Mdg,*) integer :: Mdg real(kind=wp) :: w (Mdw,*) integer :: Mdw integer :: Lw private subroutine dbndac (g, Mdg, Nb, Ip, Ir, Mt, Jt) These subroutines solve the least squares problem Ax = b for\n banded matrices A using sequential accumulation of rows of the\n data matrix. Exactly one right-hand side vector is permitted. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: g (Mdg,*) G(MDG,NB+1) Read more… integer, intent(in) :: Mdg The number of rows in the working array G(*,*) . The value of MDG should be >= MU .\nThe value of MU is defined in the abstract\nof these subprograms. integer, intent(in) :: Nb The bandwidth of the data matrix A . integer, intent(inout) :: Ip Input Set by the user to the value 1 before the\nfirst call to DBNDAC . Its subsequent value\nis controlled by DBNDAC to set up for the\nnext call to DBNDAC . Read more… integer, intent(inout) :: Ir Input Index of the row of G(*,*) where the user is\nto place the new block of data (C F) . Set by\nthe user to the value 1 before the first call\nto DBNDAC . Its subsequent value is controlled\nby DBNDAC . A value of IR > MDG is considered\nan error. Read more… integer, intent(in) :: Mt Set by the user to indicate the\nnumber of new rows of data in the block integer, intent(in) :: Jt Set by the user to indicate\nthe index of the first nonzero column in that\nset of rows (E F) = (0 C 0 F) being processed. private subroutine dbndsl (Mode, g, Mdg, Nb, Ip, Ir, x, n, Rnorm) These subroutines solve the least squares problem Ax = b for\n banded matrices A using sequential accumulation of rows of the\n data matrix. Exactly one right-hand side vector is permitted. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: Mode Set by the user to one of the values 1, 2, or\n3. These values respectively indicate that\nthe solution of AX = B , YR = H or RZ = W is\nrequired. real(kind=wp), intent(in) :: g (Mdg,*) G(MDG,NB+1) Read more… integer, intent(in) :: Mdg The number of rows in the working array G(*,*) . The value of MDG should be >= MU .\nThe value of MU is defined in the abstract\nof these subprograms. Read more… integer, intent(in) :: Nb This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ip This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ir This argument has the same meaning and\ncontents as following the last call to DBNDAC . real(kind=wp), intent(inout) :: x (*) X(N) Read more… integer, intent(in) :: n The number of variables in the solution\nvector. If any of the N diagonal terms are\nzero the subroutine DBNDSL prints an\nappropriate message. This condition is\nconsidered an error. real(kind=wp), intent(out) :: Rnorm If MODE=1 , RNORM is the Euclidean length of the\nresidual vector AX-B . When MODE=2 or 3 RNORM`\nis set to zero. private subroutine dfspvn (t, Jhigh, Index, x, Ileft, Vnikx, j, deltam, deltap) Calculates the value of all possibly nonzero B-splines at X of\n order MAX(JHIGH,(J+1)(INDEX-1)) on T . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: t (*) integer, intent(in) :: Jhigh integer, intent(in) :: Index real(kind=wp), intent(in) :: x integer, intent(in) :: Ileft real(kind=wp) :: Vnikx (*) integer, intent(inout) :: j JW : added real(kind=wp), intent(inout), dimension(20) :: deltam JW : added real(kind=wp), intent(inout), dimension(20) :: deltap JW : added private subroutine dh12 (Mode, Lpivot, l1, m, u, Iue, Up, c, Ice, Icv, Ncv) Construction and/or application of a single\n Householder transformation. Q = I + U*(U**T)/B Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: Mode 1 or 2 to select algorithm H1 or H2 . integer, intent(in) :: Lpivot the index of the pivot element. integer, intent(in) :: l1 If L1 <= M the transformation will be constructed to\nzero elements indexed from L1 through M . If L1 > M the subroutine does an identity transformation. integer, intent(in) :: m see l1 real(kind=wp), intent(inout) :: u (Iue,*) On entry to H1 U() contains the pivot vector.\nOn exit from H1 U() and UP contain quantities defining the vector U of the\nHouseholder transformation. On entry to H2 U() and UP should contain quantities previously computed\nby H1. These will not be modified by H2. integer, intent(in) :: Iue the storage increment between elements of U . real(kind=wp), intent(inout) :: Up see u real(kind=wp), intent(inout) :: c (*) On entry to H1 or H2 C() contains a matrix which will be\nregarded as a set of vectors to which the Householder\ntransformation is to be applied. On exit C() contains the\nset of transformed vectors. integer, intent(in) :: Ice Storage increment between elements of vectors in C() . integer, intent(in) :: Icv Storage increment between vectors in C() . integer, intent(in) :: Ncv Number of vectors in C() to be transformed. If NCV <= 0 no operations will be done on C() . private subroutine dsort (n, Kflag, Dx, Dy) Sort an array and optionally make the same interchanges in\n an auxiliary array. The array may be sorted in increasing\n or decreasing order. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: n number of values in array DX to be sorted integer, intent(in) :: Kflag control parameter:\n * Kflag < 0 : sort DX in decreasing order and optionally carry DY along.\n * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real(kind=wp), intent(inout), dimension(*) :: Dx array of values to be sorted (usually abscissas) real(kind=wp), intent(inout), optional, dimension(*) :: Dy array to be (optionally) carried along private subroutine sort_ascending (n, dx, dy) Recursive quicksoft.\n Modified to also carry along a second array. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=wp), intent(inout), dimension(*) :: dx array of values to be sorted real(kind=wp), intent(inout), optional, dimension(*) :: dy array to be (optionally) carried along public subroutine dfc (ndata, xdata, ydata, sddata, nord, Nbkpt, Bkpt, nconst, xconst, yconst, nderiv, mode, coeff, w, iw) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense.\n Equality and inequality constraints can be imposed on the\n fitted curve. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in) :: xdata (*) X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in) :: ydata (*) Y data array. real(kind=wp), intent(in) :: sddata (*) Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(*) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: nconst The number of conditions that constrain the\nB-spline is NCONST. A constraint is specified\nby an (X,Y) pair in the arrays XCONST( ) and\nYCONST( ), and by the type of constraint and\nderivative value encoded in the array\nNDERIV(*). real(kind=wp), intent(in) :: xconst (*) X value of constraint.\nNo sorting of XCONST(*) is required. real(kind=wp), intent(in) :: yconst (*) Y value of constraint integer, intent(in) :: nderiv (*) The value of NDERIV(*) is\n determined as follows. Suppose the I-th\n constraint applies to the J-th derivative\n of the B-spline. (Any non-negative value of\n J < NORD is permitted. In particular the\n value J=0 refers to the B-spline itself.)\n For this I-th constraint, set Read more… integer, intent(inout) :: mode Input Read more… real(kind=wp), intent(out) :: coeff (*) If the output value of MODE=0 or 1, this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD\nparameters are the B-spline coefficients.\nFor MODE=1, the equality constraints are\ncontradictory. To make the fitting process\nmore robust, the equality constraints are\nsatisfied in a least squares sense. In this\ncase the array COEFF( ) contains B-spline\ncoefficients for this extended concept of a\nsolution. If MODE=-1,2 or 3 on output, the\narray COEFF( ) is undefined. real(kind=wp) :: w (*) real work array of length IW(1) . The\n contents of W(*) must not be modified by the\n user if the variance function is desired. Read more… integer :: iw (*) integer work array of length IW(2) Read more… private subroutine dfcmn (ndata, xdata, ydata, sddata, nord, nbkpt, bkptin, nconst, xconst, yconst, nderiv, mode, coeff, bf, xtemp, ptemp, bkpt, g, mdg, w, mdw, work, iwork) This is a companion subprogram to DFC .\n The documentation for DFC has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name integer :: ndata real(kind=wp) :: xdata (*) real(kind=wp) :: ydata (*) real(kind=wp) :: sddata (*) integer :: nord integer :: nbkpt real(kind=wp) :: bkptin (*) integer :: nconst real(kind=wp) :: xconst (*) real(kind=wp) :: yconst (*) integer :: nderiv (*) integer :: mode real(kind=wp) :: coeff (*) real(kind=wp) :: bf (nord,*) real(kind=wp) :: xtemp (*) real(kind=wp) :: ptemp (*) real(kind=wp) :: bkpt (*) real(kind=wp) :: g (mdg,*) integer :: mdg real(kind=wp) :: w (mdw,*) integer :: mdw real(kind=wp) :: work (*) integer :: iwork (*) private subroutine dfspvd (t, k, x, ileft, vnikx, nderiv) Calculates value and derivs of all B-splines which do not vanish at X Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: t (*) integer :: k real(kind=wp) :: x integer :: ileft real(kind=wp) :: vnikx (k,*) integer :: nderiv private subroutine dhfti (a, mda, m, n, b, mdb, nb, tau, krank, rnorm, h, g, ip) Solve a least squares problem for banded matrices using\n sequential accumulation of rows of the data matrix.\n Exactly one right-hand side vector is permitted. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: a (mda,*) A(MDA,N) .\nThe array A( , ) initially contains the M by N\nmatrix A of the least squares problem AX = B.\nThe first dimensioning parameter of the array\nA( , ) is MDA, which must satisfy MDA>=M\nEither M>=N or M0\nthe array B( ) must initially contain the M by\nNB matrix B of the least squares problem AX =\nB. If NB>=2 the array B( ) must be doubly\nsubscripted with first dimensioning parameter\nMDB>=MAX(M,N). If NB = 1 the array B( ) may\nbe either doubly or singly subscripted. In\nthe latter case the value of MDB is arbitrary\nbut it should be set to some valid integer\nvalue such as MDB = M. Read more… integer, intent(in) :: mdb actual leading dimension of b integer, intent(in) :: nb real(kind=wp), intent(in) :: tau Absolute tolerance parameter provided by user\nfor pseudorank determination. integer, intent(out) :: krank Set by the subroutine to indicate the\npseudorank of A. real(kind=wp), intent(out) :: rnorm (*) RNORM(NB) .\nOn return, RNORM(J) will contain the Euclidean\nnorm of the residual vector for the problem\ndefined by the J-th column vector of the array\nB( , ) for J = 1,...,NB. real(kind=wp) :: h (*) H(N) . Array of working space used by DHFTI.\nOn return, contains\nelements of the pre-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. real(kind=wp) :: g (*) G(N) . Array of working space used by DHFTI.\nOn return, contain\nelements of the post-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. integer :: ip (*) IP(N) . Array of working space used by DHFTI.\nArray in which the subroutine records indices\ndescribing the permutation of column vectors.\nnot generally required by the user. private subroutine dlpdp (a, mda, m, n1, n2, prgopt, x, wnorm, mode, ws, is) Determine an N1-vector W, and\n an N2-vector Z\n which minimizes the Euclidean length of W\n subject to G W+H Z >= Y.\n This is the least projected distance problem, LPDP.\n The matrices G and H are of respective\n dimensions M by N1 and M by N2. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: a (mda,*) A(MDA,N+1) , where N=N1+N2 . integer, intent(in) :: mda integer :: m integer, intent(in) :: n1 integer, intent(in) :: n2 real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) X(N) , where N=N1+N2 . real(kind=wp) :: wnorm integer, intent(out) :: mode The value of MODE indicates the status of\nthe computation after returning to the user. Read more… real(kind=wp) :: ws (*) WS((M+2)*(N+7)) , where N=N1+N2 . This is a slight overestimate for WS(*). integer :: is (*) IS(M+N+1) , where N=N1+N2 . private subroutine dlsei (w, mdw, me, ma, mg, n, prgopt, x, rnorme, rnorml, mode, ws, ip) This subprogram solves a linearly constrained least squares\n problem with both equality and inequality constraints, and, if the\n user requests, obtains a covariance matrix of the solution\n parameters. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer, intent(in) :: mdw integer :: me integer :: ma integer :: mg integer :: n real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorme real(kind=wp) :: rnorml integer :: mode real(kind=wp) :: ws (*) integer :: ip (3) private subroutine dlsi (w, mdw, ma, mg, n, prgopt, x, rnorm, mode, ws, ip) This is a companion subprogram to DLSEI . The documentation for DLSEI has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) W(*,*) contains: Read more… integer, intent(in) :: mdw contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: ma contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: mg contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: n contain (resp) var. dimension of W(*,*) , and matrix dimensions. real(kind=wp), intent(in) :: prgopt (*) Program option vector. real(kind=wp), intent(out) :: x (*) Solution vector(unless MODE=2) real(kind=wp), intent(out) :: rnorm length of AX-B. integer, intent(out) :: mode Read more… real(kind=wp) :: ws (*) Working storage of dimension K+N+(MG+2)*(N+7) ,\nwhere K=MAX(MA+MG,N) . integer :: ip (*) IP(MG+2*N+1) Integer working storage private subroutine dwnlit (w, mdw, m, n, l, ipivot, itype, h, scale, rnorm, idope, dope, done) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: m integer :: n integer :: l integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: rnorm integer :: idope (*) real(kind=wp) :: dope (*) logical :: done private subroutine dwnlsm (w, mdw, mme, ma, n, l, prgopt, x, rnorm, mode, ipivot, itype, wd, h, scale, z, temp, d) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: mme integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: wd (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: z (*) real(kind=wp) :: temp (*) real(kind=wp) :: d (*) private subroutine dwnlt1 (i, lend, mend, ir, mdw, recalc, imax, hbar, h, scale, w) To update the column Sum Of Squares and find the pivot column.\n The column Sum of Squares Vector will be updated at each step.\n When numerically necessary, these values will be recomputed. Read more… Arguments Type Intent Optional Attributes Name integer :: i integer :: lend integer :: mend integer :: ir integer :: mdw logical :: recalc integer :: imax real(kind=wp) :: hbar real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: w (mdw,*) private subroutine dwnlt3 (i, imax, m, mdw, ipivot, h, w) Perform column interchange.\n Exchange elements of permuted index vector and perform column\n interchanges. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: i integer, intent(in) :: imax integer, intent(in) :: m integer, intent(in) :: mdw integer, intent(inout) :: ipivot (*) real(kind=wp), intent(inout) :: h (*) real(kind=wp), intent(inout) :: w (mdw,*) private subroutine dwnnls (w, mdw, me, ma, n, l, prgopt, x, rnorm, mode, iwork, work) This subprogram solves a linearly constrained least squares\n problem. Suppose there are given matrices E and A of\n respective dimensions ME by N and MA by N , and vectors F and B of respective lengths ME and MA . This subroutine\n solves the problem Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: me integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: iwork (*) real(kind=wp) :: work (*)","tags":"","loc":"module/bspline_defc_module.html"},{"title":"bspline_sub_module – bspline-fortran","text":"Description Multidimensional (1D-6D) B-spline interpolation of data on a regular grid.\n Basic pure subroutine interface. Notes This module is based on the B-spline and spline routines from [1].\n The original Fortran 77 routines were converted to free-form source.\n Some of them are relatively unchanged from the originals, but some have\n been extensively refactored. In addition, new routines for\n 1d, 4d, 5d, and 6d interpolation were also created (these are simply\n extensions of the same algorithm into higher dimensions). See also An object-oriented interface can be found in bspline_oo_module . References DBSPLIN and DTENSBS from the NIST Core Math Library .\n Original code is public domain. Carl de Boor, \"A Practical Guide to Splines\",\n Springer-Verlag, New York, 1978. Carl de Boor, Efficient Computer Manipulation of Tensor\n Products ,\n ACM Transactions on Mathematical Software,\n Vol. 5 (1979), p. 173-182. D.E. Amos, \"Computation with Splines and B-Splines\",\n SAND78-1968, Sandia Laboratories, March, 1979. Carl de Boor, Package for calculating with B-splines ,\n SIAM Journal on Numerical Analysis 14, 3 (June 1977), p. 441-472. D.E. Amos, \"Quadrature subroutines for splines and B-splines\",\n Report SAND79-1825, Sandia Laboratories, December 1979. Uses bspline_kinds_module iso_fortran_env module~~bspline_sub_module~~UsesGraph module~bspline_sub_module bspline_sub_module iso_fortran_env iso_fortran_env module~bspline_sub_module->iso_fortran_env module~bspline_kinds_module bspline_kinds_module module~bspline_sub_module->module~bspline_kinds_module module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_sub_module~~UsedByGraph module~bspline_sub_module bspline_sub_module module~bspline_module bspline_module module~bspline_module->module~bspline_sub_module module~bspline_oo_module bspline_oo_module module~bspline_module->module~bspline_oo_module module~bspline_oo_module->module~bspline_sub_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer(kind=ip), public, parameter :: bspline_order_linear = 2_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_quadratic = 3_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_cubic = 4_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_quartic = 5_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_quintic = 6_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_hexic = 7_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_heptic = 8_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_octic = 9_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] Interfaces public interface db1ink 1D initialization routines. private pure subroutine db1ink_default (x, nx, fcn, kx, iknot, tx, bcoef, iflag) Determines the parameters of a function that interpolates\n the one-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db1val . History Jacob Williams, 10/30/2015 : Created 1D routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant: Read more… real(kind=wp), intent(out), dimension(:) :: bcoef (nx) array of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt_2 (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… public interface db1val 1D evaluation routines. private pure subroutine db1val_default (xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . To evaluate the interpolant itself, set idx=0 ,\n to evaluate the first partial with respect to x , set idx=1 , and so on. db1val returns 0.0 if ( xval , yval ) is out of range. that is, if xval < tx ( 1 ) . or . xval > tx ( nx + kx ) if the knots tx were chosen by db1ink , then this is equivalent to: xval < x ( 1 ) . or . xval > x ( nx ) + epsx where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) The input quantities tx , nx , kx , and bcoef should be\n unchanged since the last call of db1ink . History Jacob Williams, 10/30/2015 : Created 1D routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine db1val_alt (xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Abstract Interfaces abstract interface public function b1fqad_func(x) result(f) interface for the input function in dbfqad Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x Return Value real(kind=wp) f(x) Functions private pure function check_value (x, t, i, extrap) result(iflag) Checks if the value is withing the range of the knot vectors.\nThis is called by the various db*val routines. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x the value to check real(kind=wp), intent(in), dimension(:) :: t the knot vector integer(kind=ip), intent(in) :: i 1=x, 2=y, 3=z, 4=q, 5=r, 6=s logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value integer(kind=ip) returns 0 if value is OK, otherwise returns 600+i private pure function get_temp_x_for_extrap (x, tmin, tmax, extrap) result(xt) Returns the value of x to use for computing the interval\nin t , depending on if extrapolation is allowed or not. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x variable value real(kind=wp), intent(in) :: tmin first knot vector element for b-splines real(kind=wp), intent(in) :: tmax last knot vector element for b-splines logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value real(kind=wp) The value returned (it will either\nbe tmin , x , or tmax ) public pure function get_status_message (iflag) result(msg) Returns a message string associated with the status code. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iflag return code from one of the routines Return Value character(len=:), allocatable status message associated with the flag Subroutines private pure subroutine db1ink_default (x, nx, fcn, kx, iknot, tx, bcoef, iflag) Determines the parameters of a function that interpolates\n the one-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db1val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant: Read more… real(kind=wp), intent(out), dimension(:) :: bcoef (nx) array of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt_2 (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1val_default (xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine db1val_alt (xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db1sqad (tx, bcoef, nx, kx, x1, x2, f, iflag, w0) Computes the integral on (x1,x2) of a kx -th order b-spline.\n Orders kx as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(out) :: f integral of the b-spline over ( x1 , x2 ) integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(inout), dimension(3*kx) :: w0 work array for dbsqad public subroutine db1fqad (fun, tx, bcoef, nx, kx, idx, x1, x2, tol, f, iflag, w0) Computes the integral on (x1,x2) of a product of a\n function fun and the idx -th derivative of a kx -th order b-spline,\n using the b-representation (tx,bcoef,nx,kx) , with an adaptive\n 8-point Legendre-Gauss algorithm. (x1,x2) must be a subinterval of t(kx) <= x <= t(nx+1) . Read more… Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work) real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, kx >= 1 integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: f integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array for dbfqad public pure subroutine db2ink (x, nx, y, ny, fcn, kx, ky, iknot, tx, ty, bcoef, iflag) Determines the parameters of a function that interpolates\n the two-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db2val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: ny Number of abcissae real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:) :: bcoef (nx,ny) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db2val (xval, yval, idx, idy, tx, ty, nx, ny, kx, ky, bcoef, f, iflag, inbvx, inbvy, iloy, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db2ink or one of its\n derivatives at the point ( xval , yval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise\npolynomial in the direction.\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(nx,ny) :: bcoef the b-spline coefficients computed by db2ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db3ink (x, nx, y, ny, z, nz, fcn, kx, ky, kz, iknot, tx, ty, tz, bcoef, iflag) Determines the parameters of a function that interpolates\n the three-dimensional gridded data The interpolating function and\n its derivatives may subsequently be evaluated by the function db3val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should\ncontain the function value at the point ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:) :: bcoef (nx,ny,nz) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db3val (xval, yval, zval, idx, idy, idz, tx, ty, tz, nx, ny, nz, kx, ky, kz, bcoef, f, iflag, inbvx, inbvy, inbvz, iloy, iloz, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db3ink or one of its\n derivatives at the point ( xval , yval , zval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nx,ny,nz) :: bcoef the b-spline coefficients computed by db3ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz) :: w2 work array real(kind=wp), intent(inout), dimension(kz) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db4ink (x, nx, y, ny, z, nz, q, nq, fcn, kx, ky, kz, kq, iknot, tx, ty, tz, tq, bcoef, iflag) Determines the parameters of a function that interpolates\n the four-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db4val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,q) should contain the function value at the\n point ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the x direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the y direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the z direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the q direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:,:) :: bcoef (nx,ny,nz,nq) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db4val (xval, yval, zval, qval, idx, idy, idz, idq, tx, ty, tz, tq, nx, ny, nz, nq, kx, ky, kz, kq, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, iloy, iloz, iloq, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db4ink or one of its\n derivatives at the point ( xval , yval , zval , qval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq) :: bcoef the b-spline coefficients computed by db4ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq) :: w3 work array real(kind=wp), intent(inout), dimension(kz,kq) :: w2 work array real(kind=wp), intent(inout), dimension(kq) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db5ink (x, nx, y, ny, z, nz, q, nq, r, nr, fcn, kx, ky, kz, kq, kr, iknot, tx, ty, tz, tq, tr, bcoef, iflag) Determines the parameters of a function that interpolates\n the five-dimensional gridded data: Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,q,r) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db5val (xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, tx, ty, tz, tq, tr, nx, ny, nz, nq, nr, kx, ky, kz, kq, kr, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, iloy, iloz, iloq, ilor, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db5ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr) :: bcoef the b-spline coefficients computed by db5ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr) :: w4 work array real(kind=wp), intent(inout), dimension(kz,kq,kr) :: w3 work array real(kind=wp), intent(inout), dimension(kq,kr) :: w2 work array real(kind=wp), intent(inout), dimension(kr) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db6ink (x, nx, y, ny, z, nz, q, nq, r, nr, s, ns, fcn, kx, ky, kz, kq, kr, ks, iknot, tx, ty, tz, tq, tr, ts, bcoef, iflag) Determines the parameters of a function that interpolates\n the six-dimensional gridded data: Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ns number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to\ninterpolate. fcn(i,j,k,q,r,s) should contain the\nfunction value at the point\n( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ts The (ns+ks) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr,ns) matrix of coefficients of the\nb-spline interpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db6val (xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, tx, ty, tz, tq, tr, ts, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, inbvs, iloy, iloz, iloq, ilor, ilos, w5, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db6ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval , sval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ns+ks) :: ts sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ns the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ks order of polynomial pieces in .\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr,ns) :: bcoef the b-spline coefficients computed by db6ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvs initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilos initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr,ks) :: w5 work array real(kind=wp), intent(inout), dimension(kz,kq,kr,ks) :: w4 work array real(kind=wp), intent(inout), dimension(kq,kr,ks) :: w3 work array real(kind=wp), intent(inout), dimension(kr,ks) :: w2 work array real(kind=wp), intent(inout), dimension(ks) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr,ks)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine check_inputs (iknot, iflag, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, x, y, z, q, r, s, tx, ty, tz, tq, tr, ts, f1, f2, f3, f4, f5, f6, bcoef1, bcoef2, bcoef3, bcoef4, bcoef5, bcoef6, alt, status_ok) Check the validity of the inputs to the db*ink routines.\n Prints warning message if there is an error,\n and also sets iflag and status_ok. Read more… Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iknot = 0 if the INK routine is computing the knots. integer(kind=ip), intent(out) :: iflag integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: x real(kind=wp), intent(in), optional, dimension(:) :: y real(kind=wp), intent(in), optional, dimension(:) :: z real(kind=wp), intent(in), optional, dimension(:) :: q real(kind=wp), intent(in), optional, dimension(:) :: r real(kind=wp), intent(in), optional, dimension(:) :: s real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts real(kind=wp), intent(in), optional, dimension(:) :: f1 real(kind=wp), intent(in), optional, dimension(:,:) :: f2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: f3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: f4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: f5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: f6 real(kind=wp), intent(in), optional, dimension(:) :: bcoef1 real(kind=wp), intent(in), optional, dimension(:,:) :: bcoef2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: bcoef3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: bcoef4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: bcoef5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: bcoef6 logical, intent(in), optional :: alt using the alt routine where 1st or\n2nd deriv is fixed at endpoints\n[default is False] logical, intent(out) :: status_ok private pure subroutine dbknot (x, n, k, t) dbknot chooses a knot sequence for interpolation of order k at the\n data points x(i), i=1,..,n. the n+k knots are placed in the array\n t. k knots are placed at each endpoint and not-a-knot end\n conditions are used. the remaining knots are placed at data points\n if n is even and between data points if n is odd. the rightmost\n knot is shifted slightly to the right to insure proper interpolation\n at x(n) (see page 350 of the reference). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(:) :: t private pure subroutine dbtpcf (x, n, fcn, ldf, nf, t, k, bcoef, work, iflag) dbtpcf computes b-spline interpolation coefficients for nf sets\n of data stored in the columns of the array fcn. the b-spline\n coefficients are stored in the rows of bcoef however.\n each interpolation is based on the n abcissa stored in the\n array x, and the n+k knots stored in the array t. the order\n of each interpolation is k. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x real(kind=wp), intent(in), dimension(ldf,nf) :: fcn integer(kind=ip), intent(in) :: ldf integer(kind=ip), intent(in) :: nf real(kind=wp), intent(in), dimension(:) :: t integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(nf,n) :: bcoef real(kind=wp), intent(out), dimension(*) :: work work array of size >= 2*k*(n+1) integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine dbintk (x, y, t, n, k, bcoef, q, work, iflag) dbintk produces the b-spline coefficients, bcoef, of the\n b-spline of order k with knots t(i), i=1,...,n+k, which\n takes on the value y(i) at x(i), i=1,...,n. the spline or\n any of its derivatives can be evaluated by calls to dbvalu . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(n) :: x vector of length n containing data point abscissa\nin strictly increasing order. real(kind=wp), intent(in), dimension(n) :: y corresponding vector of length n containing data\npoint ordinates. real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k\nsince t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) Read more… integer(kind=ip), intent(in) :: n number of data points, n >= k integer(kind=ip), intent(in) :: k order of the spline, k >= 1 real(kind=wp), intent(out), dimension(n) :: bcoef a vector of length n containing the b-spline coefficients real(kind=wp), intent(out), dimension(*) :: q a work vector of length (2 k-1) n, containing\nthe triangular factorization of the coefficient\nmatrix of the linear system being solved. the\ncoefficients for the interpolant of an\nadditional data set (x(i),yy(i)), i=1,...,n\nwith the same abscissa can be obtained by loading\nyy into bcoef and then executing\ncall dbnslv(q,2k-1,n,k-1,k-1,bcoef) real(kind=wp), intent(out), dimension(*) :: work work vector of length 2*k integer(kind=ip), intent(out) :: iflag Read more… private pure subroutine dbnfac (w, nroww, nrow, nbandl, nbandu, iflag) Returns in w the LU-factorization (without pivoting) of the banded\n matrix a of order nrow with (nbandl + 1 + nbandu) bands or diagonals\n in the work array w . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout), dimension(nroww,nrow) :: w work array. See header for details. integer(kind=ip), intent(in) :: nroww row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer(kind=ip), intent(in) :: nrow matrix order integer(kind=ip), intent(in) :: nbandl number of bands of a below the main diagonal integer(kind=ip), intent(in) :: nbandu number of bands of a above the main diagonal integer(kind=ip), intent(out) :: iflag indicating success(=1) or failure (=2) private pure subroutine dbnslv (w, nroww, nrow, nbandl, nbandu, b) Companion routine to dbnfac . it returns the solution x of the\n linear system a*x = b in place of b, given the lu-factorization\n for a in the work array w from dbnfac. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nroww,nrow) :: w describes the lu-factorization of a banded matrix a of\norder nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nroww describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nrow describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandl describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandu describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . real(kind=wp), intent(inout), dimension(nrow) :: b Read more… private pure subroutine dbspvn (t, jhigh, k, index, x, ileft, vnikx, work, iwork, iflag) Calculates the value of all (possibly) nonzero basis\n functions at x of order max(jhigh,(j+1)*(index-1)), where t(k)\n <= x <= t(n+1) and j=iwork is set inside the routine on\n the first call when index=1. ileft is such that t(ileft) <=\n x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag)\n produces the proper ileft. dbspvn calculates using the basic\n algorithm needed in dbspvd. if only basis functions are\n desired, setting jhigh=k and index=1 can be faster than\n calling dbspvd, but extra coding is required for derivatives\n (index=2) and dbspvd is set up for this purpose. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities- k dimension t(ileft+jhigh) integer(kind=ip), intent(in) :: jhigh order of b-spline, 1 <= jhigh <= k integer(kind=ip), intent(in) :: k highest possible order integer(kind=ip), intent(in) :: index index = 1 gives basis functions of order jhigh = 2 denotes previous entry with work , iwork values saved for subsequent calls to\n dbspvn. real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) real(kind=wp), intent(out), dimension(k) :: vnikx vector of length k for spline values. real(kind=wp), intent(inout), dimension(*) :: work a work vector of length 2*k integer(kind=ip), intent(inout) :: iwork a work parameter. both work and iwork contain\ninformation necessary to continue for index = 2 .\nwhen index = 1 exclusively, these are scratch\nvariables and can be used for other purposes. integer(kind=ip), intent(out) :: iflag Read more… private pure subroutine dbvalu (t, a, n, k, ideriv, x, inbv, work, iflag, val, extrap) Evaluates the b-representation ( t , a , n , k ) of a b-spline\n at x for the function value on ideriv=0 or any of its\n derivatives on ideriv=1,2,...,k-1 . right limiting values\n (right derivatives) are returned except at the right end\n point x=t(n+1) where left limiting values are computed. the\n spline is defined on t(k) x t(n+1) .\n dbvalu returns a fatal error message when x is outside of this\n interval. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k real(kind=wp), intent(in), dimension(n) :: a b-spline coefficient vector of length n integer(kind=ip), intent(in) :: n number of b-spline coefficients.\n(sum of knot multiplicities- k ) integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: ideriv order of the derivative, 0 <= ideriv <= k-1 . ideriv = 0 returns the b-spline value real(kind=wp), intent(in) :: x argument, t(k) <= x <= t(n+1) integer(kind=ip), intent(inout) :: inbv an initialization parameter which must be set\nto 1 the first time dbvalu is called. inbv contains information for efficient processing\nafter the initial call and inbv must not\nbe changed by the user. distinct splines require\ndistinct inbv parameters. real(kind=wp), intent(inout), dimension(:) :: work work vector of length at least 3*k integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(out) :: val the interpolated value logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine dintrv (xt, lxt, xx, ilo, ileft, mflag, extrap) Computes the largest integer ileft in 1 ileft lxt such that xt(ileft) x where xt(*) is a subdivision of\n the x interval.\n precisely, Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: xt a knot or break point vector of length lxt integer(kind=ip), intent(in) :: lxt length of the xt vector real(kind=wp), intent(in) :: xx argument integer(kind=ip), intent(inout) :: ilo an initialization parameter which must be set\nto 1 the first time the spline array xt is\nprocessed by dintrv. ilo contains information for\nefficient processing after the initial call and ilo must not be changed by the user. distinct splines\nrequire distinct ilo parameters. integer(kind=ip), intent(out) :: ileft largest integer satisfying xt(ileft) x integer(kind=ip), intent(out) :: mflag signals when x lies out of bounds logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine dbint4 (x, y, ndata, ibcl, ibcr, fbcl, fbcr, kntopt, tleft, tright, t, bcoef, n, k, w, iflag) DBINT4 computes the B representation ( t , bcoef , n , k ) of a\n cubic spline ( k=4 ) which interpolates data ( x(i) , y(i) ), i=1,ndata . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x x vector of abscissae of length ndata , distinct\nand in increasing order real(kind=wp), intent(in), dimension(:) :: y y vector of ordinates of length ndata integer(kind=ip), intent(in) :: ndata number of data points, ndata >= 2 integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(in), dimension(3) :: tleft when kntopt = 3 : t(1:3) in increasing\norder to be supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright when kntopt = 3 : t(n+2:n+4) in increasing\norder to be supplied by the user. real(kind=wp), intent(out), dimension(:) :: t knot array of length n+4 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length n integer(kind=ip), intent(out) :: n number of coefficients, n=ndata+2 integer(kind=ip), intent(out) :: k order of spline, k=4 real(kind=wp), intent(inout), dimension(5,ndata+2) :: w work array integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine dbspvd (t, k, nderiv, x, ileft, ldvnik, vnikx, work, iflag) DBSPVD calculates the value and all derivatives of order\n less than nderiv of all basis functions which do not\n (possibly) vanish at x . ileft is input such that t(ileft) <= x < t(ileft+1) . A call to dintrv ( t , n+1 , x , ilo , ileft , mflag ) will produce the proper ileft . The output of\n dbspvd is a matrix vnikx(i,j) of dimension at least (k,nderiv) whose columns contain the k nonzero basis functions and\n their nderiv-1 right derivatives at x , i=1,k, j=1,nderiv .\n These basis functions have indices ileft-k+i , i=1,k,\n k <= ileft <= n . The nonzero part of the i -th basis\n function lies in (t(i),t(i+k)), i=1,n) . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities-k integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: nderiv number of derivatives = nderiv-1 , 1 <= nderiv <= k real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) integer(kind=ip), intent(in) :: ldvnik leading dimension of matrix vnikx real(kind=wp), intent(out), dimension(ldvnik,nderiv) :: vnikx matrix of dimension at least (k,nderiv) containing the nonzero basis functions\nat x and their derivatives columnwise. real(kind=wp), intent(out), dimension(*) :: work a work vector of length (k+1)*(k+2)/2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine dbsqad (t, bcoef, n, k, x1, x2, bquad, work, iflag) DBSQAD computes the integral on (x1,x2) of a k -th order\n b-spline using the b-representation (t,bcoef,n,k) . orders k as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot array of length n+k real(kind=wp), intent(in), dimension(:) :: bcoef b-spline coefficient array of length n integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(out) :: bquad integral of the b-spline over ( x1 , x2 ) real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k integer(kind=ip), intent(out) :: iflag status flag: Read more… private subroutine dbfqad (f, t, bcoef, n, k, id, x1, x2, tol, quad, iflag, work) dbfqad computes the integral on (x1,x2) of a product of a\n function f and the id -th derivative of a k -th order b-spline,\n using the b-representation (t,bcoef,n,k) . (x1,x2) must be a\n subinterval of t(k) <= x <= t(n+1) . an integration routine, dbsgq8 (a modification of gaus8 ), integrates the product\n on subintervals of (x1,x2) formed by included (distinct) knots Read more… Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: f external function of one argument for the\nintegrand bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work) real(kind=wp), intent(in), dimension(n+k) :: t knot array real(kind=wp), intent(in), dimension(n) :: bcoef coefficient array integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, k >= 1 integer(kind=ip), intent(in) :: id order of the spline derivative, 0 <= id <= k-1 id=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: quad integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k private subroutine dbsgq8 (fun, xt, bc, n, kk, id, a, b, inbv, err, ans, iflag, work) DBSGQ8, a modification of gaus8 ,\n integrates the product of fun(x) by the id -th derivative of a spline dbvalu between limits a and b using an adaptive 8-point Legendre-Gauss\n algorithm. Read more… Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun name of external function of one\nargument which multiplies dbvalu . real(kind=wp), intent(in), dimension(:) :: xt knot array for dbvalu real(kind=wp), intent(in), dimension(n) :: bc b-coefficient array for dbvalu integer(kind=ip), intent(in) :: n number of b-coefficients for dbvalu integer(kind=ip), intent(in) :: kk order of the spline, kk>=1 integer(kind=ip), intent(in) :: id Order of the spline derivative, 0<=id<=kk-1 real(kind=wp), intent(in) :: a lower limit of integral real(kind=wp), intent(in) :: b upper limit of integral (may be less than a ) integer(kind=ip), intent(inout) :: inbv initialization parameter for dbvalu real(kind=wp), intent(inout) :: err IN: is a requested pseudorelative error\ntolerance. normally pick a value of abs(err)<1e-3 . ans will normally\nhave no more error than abs(err) times\nthe integral of the absolute value of fun(x)*[[dbvalu]]() . Read more… real(kind=wp), intent(out) :: ans computed value of integral integer(kind=ip), intent(out) :: iflag a status code: Read more… real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k for dbvalu","tags":"","loc":"module/bspline_sub_module.html"},{"title":"bspline_kinds_module – bspline-fortran","text":"Description Numeric kind definitions for BSpline-Fortran. Uses iso_fortran_env module~~bspline_kinds_module~~UsesGraph module~bspline_kinds_module bspline_kinds_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_kinds_module~~UsedByGraph module~bspline_kinds_module bspline_kinds_module module~bspline_blas_module bspline_blas_module module~bspline_blas_module->module~bspline_kinds_module module~bspline_defc_module bspline_defc_module module~bspline_defc_module->module~bspline_kinds_module module~bspline_defc_module->module~bspline_blas_module module~bspline_module bspline_module module~bspline_module->module~bspline_kinds_module module~bspline_module->module~bspline_defc_module module~bspline_oo_module bspline_oo_module module~bspline_module->module~bspline_oo_module module~bspline_sub_module bspline_sub_module module~bspline_module->module~bspline_sub_module module~bspline_oo_module->module~bspline_kinds_module module~bspline_oo_module->module~bspline_sub_module module~bspline_sub_module->module~bspline_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, public, parameter :: wp = real64 Real working precision if not specified [8 bytes] integer, public, parameter :: ip = int32 Integer working precision if not specified [4 bytes]","tags":"","loc":"module/bspline_kinds_module.html"},{"title":"bspline_blas_module – bspline-fortran","text":"BLAS procedures, which can be use used if not linking with a BLAS library,\n if one is not available, or if a real kind /= real64 is required. The original code has been slightly modernized. Notes reference blas level1 routines reference blas is a software package provided by univ . of tennessee , univ . of california berkeley , univ . of colorado denver and nag ltd . See also [BLAS Sourcecode](https: Uses bspline_kinds_module module~~bspline_blas_module~~UsesGraph module~bspline_blas_module bspline_blas_module module~bspline_kinds_module bspline_kinds_module module~bspline_blas_module->module~bspline_kinds_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_blas_module~~UsedByGraph module~bspline_blas_module bspline_blas_module module~bspline_defc_module bspline_defc_module module~bspline_defc_module->module~bspline_blas_module module~bspline_module bspline_module module~bspline_module->module~bspline_defc_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Functions public function ddot (n, dx, incx, dy, incy) ddot forms the dot product of two vectors.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Return Value real(kind=wp) public function dnrm2 (n, x, incx) returns the euclidean norm of a vector Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: x (*) integer(kind=ip) :: incx Return Value real(kind=wp) public function dasum (n, dx, incx) dasum takes the sum of the absolute values. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value real(kind=wp) public function idamax (n, dx, incx) idamax finds the index of the first element having maximum absolute value. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value integer Subroutines public subroutine daxpy (n, da, dx, incx, dy, incy) DAXPY constant times a vector plus a vector.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy public subroutine dcopy (n, dx, incx, dy, incy) DCOPY copies a vector, x, to a vector, y.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy public subroutine dscal (n, da, dx, incx) DSCAL scales a vector by a constant.\nuses unrolled loops for increment equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx public subroutine dswap (n, dx, incx, dy, incy) DSWAP interchanges two vectors.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy public subroutine drotm (n, dx, incx, dy, incy, dparam) apply the modified givens transformation, H, to the 2 by n matrix Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy real(kind=wp) :: dparam (5) public subroutine drotmg (dd1, dd2, dx1, dy1, dparam) construct the modified givens transformation matrix H Arguments Type Intent Optional Attributes Name real(kind=wp) :: dd1 real(kind=wp) :: dd2 real(kind=wp) :: dx1 real(kind=wp) :: dy1 real(kind=wp) :: dparam (5)","tags":"","loc":"module/bspline_blas_module.html"},{"title":"bspline_oo_module – bspline-fortran","text":"Object-oriented style wrappers to bspline_sub_module .\nThis module provides classes ( bspline_1d , bspline_2d , bspline_3d , bspline_4d , bspline_5d , and bspline_6d )\nwhich can be used instead of the main subroutine interface. Uses bspline_kinds_module bspline_sub_module iso_fortran_env module~~bspline_oo_module~~UsesGraph module~bspline_oo_module bspline_oo_module iso_fortran_env iso_fortran_env module~bspline_oo_module->iso_fortran_env module~bspline_kinds_module bspline_kinds_module module~bspline_oo_module->module~bspline_kinds_module module~bspline_sub_module bspline_sub_module module~bspline_oo_module->module~bspline_sub_module module~bspline_kinds_module->iso_fortran_env module~bspline_sub_module->iso_fortran_env module~bspline_sub_module->module~bspline_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_oo_module~~UsedByGraph module~bspline_oo_module bspline_oo_module module~bspline_module bspline_module module~bspline_module->module~bspline_oo_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer(kind=ip), private, parameter :: int_size = storage_size(1_ip, kind=ip) size of a default integer [bits] integer(kind=ip), private, parameter :: logical_size = storage_size(.true., kind=ip) size of a default logical [bits] integer(kind=ip), private, parameter :: real_size = storage_size(1.0_wp, kind=ip) size of a real(wp) [bits] Interfaces public interface bspline_1d Constructor for bspline_1d private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) public interface bspline_2d Constructor for bspline_2d private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) public interface bspline_3d Constructor for bspline_3d private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) public interface bspline_4d Constructor for bspline_4d private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) public interface bspline_5d Constructor for bspline_5d private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) public interface bspline_6d Constructor for bspline_6d private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Abstract Interfaces abstract interface private pure function size_func(me) result(s) interface for size routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits abstract interface private pure subroutine destroy_func(me) interface for bspline destructor routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Derived Types type, public :: bspline_class Base class for the b-spline types Components Type Visibility Attributes Name Initial integer(kind=ip), private :: inbvx = 1_ip internal variable used by dbvalu for efficient processing integer(kind=ip), private :: iflag = 1_ip saved iflag from the list routine call. logical, private :: initialized = .false. true if the class is initialized and ready to use logical, private :: extrap = .false. if true, then extrapolation is allowed during evaluation Type-Bound Procedures procedure, private, non_overridable :: destroy_base ../../ destructor for the abstract type procedure, private, non_overridable :: set_extrap_flag ../../ internal routine to set the extrap flag procedure( destroy_func ), public, deferred :: destroy ../../ destructor procedure( size_func ), public, deferred :: size_of ../../ size of the structure in bits procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. type, public, extends( bspline_class ) :: bspline_1d Class for 1d b-spline interpolation. Read more… Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db1val] work array of dimension 3*kx Constructor Constructor for bspline_1d private\n\n pure, elemental\n function bspline_1d_constructor_empty () It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . private\n\n pure\n function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Finalizations Procedures final :: finalize_1d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots procedure, private :: initialize_1d_auto_knots procedure, private :: initialize_1d_specify_knots procedure, public :: evaluate => evaluate_1d procedure, public :: destroy => destroy_1d procedure, public :: size_of => size_1d procedure, public :: integral => integral_1d procedure, public :: fintegral => fintegral_1d type, public, extends( bspline_class ) :: bspline_2d Class for 2d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db2val] work array of dimension ky real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db2val] work array of dimension 3_ip*max(kx,ky) Constructor Constructor for bspline_2d private\n\n elemental\n function bspline_2d_constructor_empty () It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . private\n\n pure\n function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Finalizations Procedures final :: finalize_2d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots procedure, private :: initialize_2d_auto_knots procedure, private :: initialize_2d_specify_knots procedure, public :: evaluate => evaluate_2d procedure, public :: destroy => destroy_2d procedure, public :: size_of => size_2d type, public, extends( bspline_class ) :: bspline_3d Class for 3d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:), allocatable :: work_val_1 [[db3val] work array of dimension ky,kz real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db3val] work array of dimension kz real(kind=wp), private, dimension(:), allocatable :: work_val_3 [[db3val] work array of dimension 3_ip*max(kx,ky,kz) Constructor Constructor for bspline_3d private\n\n elemental\n function bspline_3d_constructor_empty () It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . private\n\n pure\n function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Finalizations Procedures final :: finalize_3d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots procedure, private :: initialize_3d_auto_knots procedure, private :: initialize_3d_specify_knots procedure, public :: evaluate => evaluate_3d procedure, public :: destroy => destroy_3d procedure, public :: size_of => size_3d type, public, extends( bspline_class ) :: bspline_4d Class for 4d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_1 db4val work array of dimension ky,kz,kq real(kind=wp), private, dimension(:,:), allocatable :: work_val_2 db4val work array of dimension kz,kq real(kind=wp), private, dimension(:), allocatable :: work_val_3 db4val work array of dimension kq real(kind=wp), private, dimension(:), allocatable :: work_val_4 db4val work array of dimension 3_ip*max(kx,ky,kz,kq) Constructor Constructor for bspline_4d private\n\n elemental\n function bspline_4d_constructor_empty () It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . private\n\n pure\n function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Finalizations Procedures final :: finalize_4d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots procedure, private :: initialize_4d_auto_knots procedure, private :: initialize_4d_specify_knots procedure, public :: evaluate => evaluate_4d procedure, public :: destroy => destroy_4d procedure, public :: size_of => size_4d type, public, extends( bspline_class ) :: bspline_5d Class for 5d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_1 db5val work array of dimension ky,kz,kq,kr real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_2 db5val work array of dimension kz,kq,kr real(kind=wp), private, dimension(:,:), allocatable :: work_val_3 db5val work array of dimension kq,kr real(kind=wp), private, dimension(:), allocatable :: work_val_4 db5val work array of dimension kr real(kind=wp), private, dimension(:), allocatable :: work_val_5 db5val work array of dimension 3_ip*max(kx,ky,kz,kq,kr) Constructor Constructor for bspline_5d private\n\n elemental\n function bspline_5d_constructor_empty () It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . private\n\n pure\n function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Finalizations Procedures final :: finalize_5d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots procedure, private :: initialize_5d_auto_knots procedure, private :: initialize_5d_specify_knots procedure, public :: evaluate => evaluate_5d procedure, public :: destroy => destroy_5d procedure, public :: size_of => size_5d type, public, extends( bspline_class ) :: bspline_6d Class for 6d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: ns = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in integer(kind=ip), private :: ks = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ts The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvs = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilos = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: work_val_1 db6val work array of dimension ky,kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_2 db6val work array of dimension kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_3 db6val work array of dimension kq,kr,ks real(kind=wp), private, dimension(:,:), allocatable :: work_val_4 db6val work array of dimension kr,ks real(kind=wp), private, dimension(:), allocatable :: work_val_5 db6val work array of dimension ks real(kind=wp), private, dimension(:), allocatable :: work_val_6 db6val work array of dimension 3_ip*max(kx,ky,kz,kq,kr,ks) Constructor Constructor for bspline_6d private\n\n elemental\n function bspline_6d_constructor_empty () It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . private\n\n pure\n function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Finalizations Procedures final :: finalize_6d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots procedure, private :: initialize_6d_auto_knots procedure, private :: initialize_6d_specify_knots procedure, public :: evaluate => evaluate_6d procedure, public :: destroy => destroy_6d procedure, public :: size_of => size_6d Functions private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag private pure function size_1d (me) result(s) Actual size of a bspline_1d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_2d (me) result(s) Actual size of a bspline_2d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_3d (me) result(s) Actual size of a bspline_3d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_4d (me) result(s) Actual size of a bspline_4d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_5d (me) result(s) Actual size of a bspline_5d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_6d (me) result(s) Actual size of a bspline_6d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Subroutines private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me private pure subroutine destroy_base (me) Destructor for contents of the base bspline_class class.\n(this routine is called by the extended classes). Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me private pure subroutine destroy_1d (me) Destructor for bspline_1d class. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me private pure subroutine destroy_2d (me) Destructor for bspline_2d class. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me private pure subroutine destroy_3d (me) Destructor for bspline_3d class. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me private pure subroutine destroy_4d (me) Destructor for bspline_4d class. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me private pure subroutine destroy_5d (me) Destructor for bspline_5d class. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me private pure subroutine destroy_6d (me) Destructor for bspline_6d class. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me private pure elemental subroutine finalize_1d (me) Finalizer for bspline_1d class. Just a wrapper for destroy_1d . Arguments Type Intent Optional Attributes Name type( bspline_1d ), intent(inout) :: me private pure elemental subroutine finalize_2d (me) Finalizer for bspline_2d class. Just a wrapper for destroy_2d . Arguments Type Intent Optional Attributes Name type( bspline_2d ), intent(inout) :: me private pure elemental subroutine finalize_3d (me) Finalizer for bspline_3d class. Just a wrapper for destroy_3d . Arguments Type Intent Optional Attributes Name type( bspline_3d ), intent(inout) :: me private pure elemental subroutine finalize_4d (me) Finalizer for bspline_4d class. Just a wrapper for destroy_4d . Arguments Type Intent Optional Attributes Name type( bspline_4d ), intent(inout) :: me private pure elemental subroutine finalize_5d (me) Finalizer for bspline_5d class. Just a wrapper for destroy_5d . Arguments Type Intent Optional Attributes Name type( bspline_5d ), intent(inout) :: me private pure elemental subroutine finalize_6d (me) Finalizer for bspline_6d class. Just a wrapper for destroy_6d . Arguments Type Intent Optional Attributes Name type( bspline_6d ), intent(inout) :: me private pure subroutine set_extrap_flag (me, extrap) Sets the extrap flag in the class. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me logical, intent(in), optional :: extrap if not present, then False is used private pure subroutine initialize_1d_auto_knots (me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_1d_specify_knots (me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_1d (me, xval, idx, f, iflag) Evaluate a bspline_1d interpolate. This is a wrapper for db1val . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db1val ) private pure subroutine integral_1d (me, x1, x2, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1sqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(out) :: f integral of the b-spline over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) private subroutine fintegral_1d (me, fun, idx, x1, x2, tol, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1fqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv) integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(in) :: tol desired accuracy for the quadrature real(kind=wp), intent(out) :: f integral of bf(x) over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) private pure subroutine initialize_2d_auto_knots (me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_2d_specify_knots (me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_2d (me, xval, yval, idx, idy, f, iflag) Evaluate a bspline_2d interpolate. This is a wrapper for db2val . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db2val ) private pure subroutine initialize_3d_auto_knots (me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_3d_specify_knots (me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_3d (me, xval, yval, zval, idx, idy, idz, f, iflag) Evaluate a bspline_3d interpolate. This is a wrapper for db3val . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db3val ) private pure subroutine initialize_4d_auto_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_4d_specify_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_4d (me, xval, yval, zval, qval, idx, idy, idz, idq, f, iflag) Evaluate a bspline_4d interpolate. This is a wrapper for db4val . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db4val ) private pure subroutine initialize_5d_auto_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_5d_specify_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_5d (me, xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, f, iflag) Evaluate a bspline_5d interpolate. This is a wrapper for db5val . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db5val ) private pure subroutine initialize_6d_auto_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_6d_specify_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_6d (me, xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, f, iflag) Evaluate a bspline_6d interpolate. This is a wrapper for db6val . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db6val ) private pure subroutine check_knot_vectors_sizes (nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag) Error checks for the user-specified knot vector sizes. Read more… Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts integer(kind=ip), intent(out) :: iflag 0 if everything is OK","tags":"","loc":"module/bspline_oo_module.html"},{"title":"bspline_module.f90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_module.f90~~EfferentGraph sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_blas_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! !### Description ! ! Multidimensional (1D-6D) B-Spline interpolation of data on a regular grid. ! This module uses both the subroutine and object-oriented modules. module bspline_module use bspline_kinds_module , only : bspline_wp => wp use bspline_oo_module use bspline_sub_module use bspline_defc_module implicit none public !***************************************************************************************** end module bspline_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_module.f90.html"},{"title":"bspline_defc_module.F90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_defc_module.f90~~EfferentGraph sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_blas_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_defc_module.f90~~AfferentGraph sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! [[defc]] and [[dfc]] procedures and support routines from [SLATEC](https://netlib.org/slatec/src/). ! For fitting B-splines polynomials to discrete 1D data. ! !### References ! ! For a description of the B-splines and usage instructions to ! evaluate them, see: ! ! * C. W. de Boor, Package for Calculating with B-Splines. ! SIAM J. Numer. Anal., p. 441, (June, 1977). ! ! For further discussion of (constrained) curve fitting using ! B-splines, see reference 2. ! ! * R. J. Hanson, Constrained least squares curve fitting ! to discrete data using B-splines, a users guide, ! Report SAND78-1291, Sandia Laboratories, December ! 1978. ! !### History ! * Dec 2022 (Jacob Williams) : Cleanup and modernization of the SLATEC routines. ! !@note This module does not support the user-defined `ip` integer kind. ! It only uses the default integer kind. ! !@todo add `iflag` outputs to be consistent with the rest of the library. module bspline_defc_module use bspline_kinds_module , only : wp !, ip #ifndef HAS_BLAS use bspline_blas_module #endif implicit none private real ( wp ), parameter :: drelpr = epsilon ( 1.0_wp ) !! machine precision (`d1mach(4)`) #ifdef HAS_BLAS ! user is linking against an external BLAS library double precision , external :: ddot , dasum integer , external :: idamax external :: daxpy , dcopy , dscal , dswap , dnrm2 , drotm , drotmg #endif public :: defc , dfc , dcv contains !***************************************************************************************** !***************************************************************************************** !> ! This subprogram fits a piecewise polynomial curve ! to discrete data. The piecewise polynomials are ! represented as B-splines. ! The fitting is done in a weighted least squares sense. ! ! The data can be processed in groups of modest size. ! The size of the group is chosen by the user. This feature ! may be necessary for purposes of using constrained curve fitting ! with subprogram [[DFC]] on a very large data set. ! !### Evaluating the Fitted Curve ! ! To evaluate derivative number `IDER` at `XVAL`, ! use the function subprogram [[DBVALU]]. ! !```fortran ! f = dbvalu(bkpt,coeff,nbkpt-nord,nord,ider,xval,inbv,workb) !``` ! ! The output of this subprogram will not be ! defined unless an output value of `MDEOUT=1` ! was obtained from [[DEFC]], `XVAL` is in the data ! interval, and `IDER` is nonnegative and `< NORD`. ! ! The first time [[DBVALU]] is called, `INBV=1` ! must be specified. This value of `INBV` is the ! overwritten by [[DBVALU]]. The array `WORKB(*)` ! must be of length at least `3*NORD`, and must ! not be the same as the `W(*)` array used in the ! call to [[DEFC]]. ! ! [[DBVALU]] expects the breakpoint array `BKPT(*)` ! to be sorted. ! !### Revision history ! ! * 800801 DATE WRITTEN. ! WRITTEN BY R. HANSON, SANDIA NATL. LABS., ! ALB., N. M., AUGUST-SEPTEMBER, 1980. ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890531 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900510 Change Prologue comments to refer to XERMSG. (RWC) ! * 900607 Editorial changes to Prologue to make Prologues for EFC, ! DEFC, FC, and DFC look as much the same as possible. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) ! * Jacob Williams, 2022 : modernized subroutine defc ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , & Mdeout , Coeff , Lw , w ) integer , intent ( in ) :: Ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), dimension ( ndata ), intent ( in ) :: Xdata !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), dimension ( ndata ), intent ( in ) :: Ydata !! Y data array. real ( wp ), dimension ( ndata ), intent ( in ) :: Sddata !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: Nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension (:), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: Mdein !! An integer flag, with one of two possible !! values (1 or 2), that directs the subprogram !! action with regard to new data points provided !! by the user: !! !! * `= 1` The first time that [[DEFC]] has been !! entered. There are NDATA points to process. !! * `= 2` This is another entry to DEFC(). The !! subprogram [[DEFC]] has been entered with MDEIN=1 !! exactly once before for this problem. There !! are NDATA new additional points to merge and !! process with any previous points. !! (When using [[DEFC]] with MDEIN=2 it is !! important that the set of knots remain fixed at the !! same values for all entries to [[DEFC]].) integer , intent ( out ) :: Mdeout !! An output flag that indicates the status !! of the curve fit: !! !! * `=-1` A usage error of [[DEFC]] occurred. The !! offending condition is noted with the SLATEC !! library error processor, `XERMSG( )`. In case !! the working array `W(*)` is not long enough, the !! minimal acceptable length is printed. !! !! * `=1` The B-spline coefficients for the fitted !! curve have been returned in array `COEFF(*)`. !! !! * `=2` Not enough data has been processed to !! determine the B-spline coefficients. !! The user has one of two options. Continue !! to process more data until a unique set !! of coefficients is obtained, or use the !! subprogram [[DFC]] to obtain a specific !! set of coefficients. The user should read !! the usage instructions for [[DFC]] for further !! details if this second option is chosen. real ( wp ), intent ( out ) :: Coeff ( * ) !! If the output value of `MDEOUT=1`, this array !! contains the unknowns obtained from the least !! squares fitting process. These `N=NBKPT-NORD` !! parameters are the B-spline coefficients. !! For `MDEOUT=2`, not enough data was processed to !! uniquely determine the B-spline coefficients. !! In this case, and also when `MDEOUT=-1`, all !! values of `COEFF(*)` are set to zero. !! !! If the user is not satisfied with the fitted !! curve returned by [[DEFC]], the constrained !! least squares curve fitting subprogram [[DFC]] !! may be required. The work done within [[DEFC]] !! to accumulate the data can be utilized by !! the user, if so desired. This involves !! saving the first `(NBKPT-NORD+3)*(NORD+1)` !! entries of `W(*)` and providing this data !! to [[DFC]] with the \"old problem\" designation. !! The user should read the usage instructions !! for subprogram [[DFC]] for further details. integer , intent ( in ) :: Lw !! The amount of working storage actually !! allocated for the working array `W(*)`. !! This quantity is compared with the !! actual amount of storage needed in [[DEFC]]. !! Insufficient storage allocated for `W(*)` is !! an error. This feature was included in [[DEFC]] !! because misreading the storage formula !! for `W(*)` might very well lead to subtle !! and hard-to-find programming bugs. !! !! The length of the array `W(*)` must satisfy !!``` !! LW >= (NBKPT-NORD+3)*(NORD+1)+ !! (NBKPT+1)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` real ( wp ) :: w ( * ) !! Working Array. !! Its length is specified as an input parameter !! in `LW` as noted above. The contents of `W(*)` !! must not be modified by the user between calls !! to [[DEFC]] with values of `MDEIN=1,2,2,...` . !! The first `(NBKPT-NORD+3)*(NORD+1)` entries of !! `W(*)` are acceptable as direct input to [[DFC]] !! for an \"old problem\" only when `MDEOUT=1` or `2`. integer :: lbf , lbkpt , lg , lptemp , lww , lxtemp , mdg , mdw ! LWW=1 USAGE IN DEFCMN( ) OF W(*).. ! LWW,...,LG-1 W(*,*) ! LG,...,LXTEMP-1 G(*,*) ! LXTEMP,...,LPTEMP-1 XTEMP(*) ! LPTEMP,...,LBKPT-1 PTEMP(*) ! LBKPT,...,LBF BKPT(*) (LOCAL TO DEFCMN( )) ! LBF,...,LBF+NORD**2 BF(*,*) mdg = Nbkpt + 1 mdw = Nbkpt - Nord + 3 lww = 1 lg = lww + mdw * ( Nord + 1 ) lxtemp = lg + mdg * ( Nord + 1 ) lptemp = lxtemp + max ( Ndata , Nbkpt ) lbkpt = lptemp + max ( Ndata , Nbkpt ) lbf = lbkpt + Nbkpt call defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , Mdeout , & Coeff , w ( lbf ), w ( lxtemp ), w ( lptemp ), w ( lbkpt ), w ( lg ), mdg , & w ( lww ), mdw , Lw ) end subroutine defc !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DEFC]]. ! This subprogram does weighted least squares fitting of data by ! B-spline curves. ! The documentation for [[DEFC]] has complete usage instructions. ! !### Revision history ! * 800801 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900328 Added TYPE section. (WRB) ! * 900510 Convert XERRWV calls to XERMSG calls. (RWC) ! * 900604 DP version created from SP version. (RWC) subroutine defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkptin , & Mdein , Mdeout , Coeff , Bf , Xtemp , Ptemp , Bkpt , g , Mdg , w , & Mdw , Lw ) integer :: Lw , Mdein , Mdeout , Mdg , Mdw , Nbkpt , Ndata , Nord real ( wp ) :: Bf ( Nord , * ), Bkpt ( * ), Bkptin ( * ), Coeff ( * ), & g ( Mdg , * ), Ptemp ( * ), Sddata ( * ), w ( Mdw , * ), & Xdata ( * ), Xtemp ( * ), Ydata ( * ) real ( wp ) :: rnorm , xmax , xmin , xval integer :: i , idata , ileft , intseq , ip , ir , irow , l , mt , n , & nb , nordm1 , nordp1 , np1 character ( len = 8 ) :: xern1 , xern2 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Initialize variables and analyze input. n = Nbkpt - Nord np1 = n + 1 ! Initially set all output coefficients to zero. call dcopy ( n , [ 0.0_wp ], 0 , Coeff , 1 ) Mdeout = - 1 if ( Nord < 1 . or . Nord > 20 ) then write ( * , * ) 'IN DEFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' return end if if ( Nbkpt < 2 * Nord ) then write ( * , * ) 'IN DEFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE THE B-SPLINE ORDER.' return end if if ( Ndata < 0 ) then write ( * , * ) 'IN DEFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' return end if nb = ( Nbkpt - Nord + 3 ) * ( Nord + 1 ) + ( Nbkpt + 1 ) * ( Nord + 1 ) & + 2 * max ( Nbkpt , Ndata ) + Nbkpt + Nord ** 2 if ( Lw < nb ) then write ( xern1 , '(I8)' ) nb write ( xern2 , '(I8)' ) Lw write ( * , * ) 'IN DEFC, INSUFFICIENT STORAGE FOR W(*). CHECK FORMULA ' // & 'THAT READS LW>= ... . NEED = ' // xern1 // & ' GIVEN = ' // xern2 Mdeout = - 1 return end if if ( Mdein /= 1 . and . Mdein /= 2 ) then write ( * , * ) 'IN DEFC, INPUT VALUE OF MDEIN MUST BE 1-2.' return end if ! Sort the breakpoints. call dcopy ( Nbkpt , Bkptin , 1 , Bkpt , 1 ) call dsort ( Nbkpt , 1 , Bkpt ) ! Save interval containing knots. xmin = Bkpt ( Nord ) xmax = Bkpt ( np1 ) nordm1 = Nord - 1 nordp1 = Nord + 1 ! Process least squares equations. ! Sort data and an array of pointers. call dcopy ( Ndata , Xdata , 1 , Xtemp , 1 ) do i = 1 , Ndata Ptemp ( i ) = i end do ! JW : really Ptemp should be an integer array. ! it is real because they are stuffing it in ! a real work array and also using dsort on it. if ( Ndata > 0 ) then call dsort ( Ndata , 2 , Xtemp , Ptemp ) xmin = min ( xmin , Xtemp ( 1 )) xmax = max ( xmax , Xtemp ( Ndata )) end if ! Fix breakpoint array if needed. This should only involve very ! minor differences with the input array of breakpoints. do i = 1 , Nord Bkpt ( i ) = min ( Bkpt ( i ), xmin ) end do do i = np1 , Nbkpt Bkpt ( i ) = max ( Bkpt ( i ), xmax ) end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = Nord intseq = 1 do idata = 1 , Ndata ! Sorted indices are in PTEMP(*). l = int ( Ptemp ( idata )) xval = Xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= Bkpt ( ileft + 1 )) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ILEFT<=N. do ileft = ileft , n if ( xval < Bkpt ( ileft + 1 )) exit if ( Mdein == 2 ) then ! Data is being sequentially accumulated. ! Transfer previously accumulated rows from W(*,*) to ! G(*,*) and process them. call dcopy ( nordp1 , w ( intseq , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , intseq ) intseq = intseq + 1 end if end do end if ! Obtain B-spline function value. call dfspvn ( Bkpt , Nord , 1 , xval , ileft , Bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( Nord , Bf , 1 , g ( irow , 1 ), Mdg ) g ( irow , nordp1 ) = Ydata ( l ) ! Scale data if uncertainty is nonzero. if ( Sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / Sddata ( l ), g ( irow , 1 ), Mdg ) ! When staging work area is exhausted, process rows. if ( irow == Mdg - 1 ) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 end if end do ! Process last block of equations. call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) ! Finish processing any previously accumulated rows from W(*,*) ! to G(*,*). if ( Mdein == 2 ) then do i = intseq , np1 call dcopy ( nordp1 , w ( i , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , min ( n , i )) end do end if ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , np1 ) ! Transfer accumulated rows from G(*,*) to W(*,*) for ! possible later sequential accumulation. do i = 1 , np1 call dcopy ( nordp1 , g ( i , 1 ), Mdg , w ( i , 1 ), Mdw ) end do ! Solve for coefficients when possible. do i = 1 , n if ( g ( i , 1 ) == 0.0_wp ) then Mdeout = 2 return end if end do ! All the diagonal terms in the accumulated triangular ! matrix are nonzero. The solution can be computed but ! it may be unsuitable for further use due to poor ! conditioning or the lack of constraints. No checking ! for either of these is done here. call dbndsl ( 1 , g , Mdg , Nord , ip , ir , Coeff , n , rnorm ) Mdeout = 1 end subroutine defcmn !***************************************************************************************** !***************************************************************************************** !> ! These subroutines solve the least squares problem `Ax = b` for ! banded matrices A using sequential accumulation of rows of the ! data matrix. Exactly one right-hand side vector is permitted. ! ! These subroutines are intended for the type of least squares ! systems that arise in applications such as curve or surface ! fitting of data. The least squares equations are accumulated and ! processed using only part of the data. This requires a certain ! user interaction during the solution of Ax = b. ! ! Specifically, suppose the data matrix (A B) is row partitioned ! into Q submatrices. Let (E F) be the T-th one of these ! submatrices where E = (0 C 0). Here the dimension of E is MT by N ! and the dimension of C is MT by NB. The value of NB is the ! bandwidth of A. The dimensions of the leading block of zeros in E ! are MT by JT-1. ! ! The user of the subroutine DBNDAC provides MT,JT,C and F for ! T=1,...,Q. Not all of this data must be supplied at once. ! ! Following the processing of the various blocks (E F), the matrix ! (A B) has been transformed to the form (R D) where R is upper ! triangular and banded with bandwidth NB. The least squares ! system Rx = d is then easily solved using back substitution by ! executing the statement CALL DBNDSL(1,...). The sequence of ! values for JT must be nondecreasing. This may require some ! preliminary interchanges of rows and columns of the matrix A. ! ! The primary reason for these subroutines is that the total ! processing can take place in a working array of dimension MU by ! NB+1. An acceptable value for MU is ! ! MU = MAX(MT + N + 1), ! ! where N is the number of unknowns. ! ! Here the maximum is taken over all values of MT for T=1,...,Q. ! Notice that MT can be taken to be a small as one, showing that ! MU can be as small as N+2. The subprogram DBNDAC processes the ! rows more efficiently if MU is large enough so that each new ! block (C F) has a distinct value of JT. ! ! The four principle parts of these algorithms are obtained by the ! following call statements: ! ! * `CALL [[DBNDAC]](...)` Introduce new blocks of data. ! * `CALL [[DBNDSL]](1,...)` Compute solution vector and length of ! residual vector. ! * `CALL [[DBNDSL]](2,...)` Given any row vector H solve YR = H for the ! row vector Y. ! * `CALL [[DBNDSL]](3,...)` Given any column vector W solve RZ = W for ! the column vector Z. ! !### Remarks ! ! To obtain the upper triangular matrix and transformed right-hand ! side vector D so that the super diagonals of R form the columns ! of G(*,*), execute the following Fortran statements. ! !```fortran ! nbp1=nb+1 ! do j=1, nbp1 ! g(ir,j) = 0.0 ! end do ! mt=1 ! jt=n+1 ! call dbndac(g,mdg,nb,ip,ir,mt,jt) !``` ! !### References ! ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974, Chapter 27. ! !### Revision history ! * 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dbndac ( g , Mdg , Nb , Ip , Ir , Mt , Jt ) implicit none integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of MDG should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. real ( wp ), intent ( inout ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! *Input* !! The working array into which the user will !! place the `MT` by `NB+1` block `(C F)` in rows `IR` !! through `IR+MT-1`, columns 1 through `NB+1`. !! See descriptions of `IR` and `MT` below. !! !! *Output* !! The working array which will contain the !! processed rows of that part of the data !! matrix which has been passed to [[DBNDAC]]. integer , intent ( in ) :: Nb !! The bandwidth of the data matrix `A`. integer , intent ( inout ) :: Ip !! *Input* !! Set by the user to the value 1 before the !! first call to [[DBNDAC]]. Its subsequent value !! is controlled by [[DBNDAC]] to set up for the !! next call to [[DBNDAC]]. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( inout ) :: Ir !! *Input* !! Index of the row of `G(*,*)` where the user is !! to place the new block of data `(C F)`. Set by !! the user to the value 1 before the first call !! to [[DBNDAC]]. Its subsequent value is controlled !! by [[DBNDAC]]. A value of `IR > MDG` is considered !! an error. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( in ) :: Mt !! Set by the user to indicate the !! number of new rows of data in the block integer , intent ( in ) :: Jt !! Set by the user to indicate !! the index of the first nonzero column in that !! set of rows `(E F) = (0 C 0 F)` being processed. real ( wp ) :: rho integer :: i , ie , ig , ig1 , ig2 , iopt , j , jg , & k , kh , l , lp1 , mh , mu , nbp1 , nerr real ( wp ), parameter :: zero = 0.0_wp ! ALG. STEPS 1-4 ARE PERFORMED EXTERNAL TO THIS SUBROUTINE. nbp1 = Nb + 1 if ( Mt <= 0 . or . Nb <= 0 ) return if (. not . Mdg < Ir ) then if ( Jt /= Ip ) then if ( Jt > Ir ) then do i = 1 , Mt ig1 = Jt + Mt - i ig2 = Ir + Mt - i do j = 1 , nbp1 g ( ig1 , j ) = g ( ig2 , j ) end do end do ie = Jt - Ir do i = 1 , ie ig = Ir + i - 1 do j = 1 , nbp1 g ( ig , j ) = zero end do end do Ir = Jt end if mu = min ( Nb - 1 , Ir - Ip - 1 ) if ( mu /= 0 ) then do l = 1 , mu k = min ( l , Jt - Ip ) lp1 = l + 1 ig = Ip + l do i = lp1 , Nb jg = i - k g ( ig , jg ) = g ( ig , i ) end do do i = 1 , k jg = nbp1 - i g ( ig , jg ) = zero end do end do end if Ip = Jt end if mh = Ir + Mt - Ip kh = min ( nbp1 , mh ) do i = 1 , kh call dh12 ( 1 , i , max ( i + 1 , Ir - Ip + 1 ), mh , g ( Ip , i ), 1 , & rho , g ( Ip , i + 1 ), 1 , Mdg , nbp1 - i ) end do Ir = Ip + kh if ( kh >= nbp1 ) then do i = 1 , Nb g ( Ir - 1 , i ) = zero end do end if else nerr = 1 iopt = 2 write ( * , * ) 'MDG ! These subroutines solve the least squares problem `Ax = b` for ! banded matrices A using sequential accumulation of rows of the ! data matrix. Exactly one right-hand side vector is permitted. ! ! See [[dbndac]] for a full description of how to use them. ! !### References ! ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974, Chapter 27. ! !### Revision history ! * 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dbndsl ( Mode , g , Mdg , Nb , Ip , Ir , x , n , Rnorm ) integer , intent ( in ) :: Mode !! Set by the user to one of the values 1, 2, or !! 3. These values respectively indicate that !! the solution of `AX = B`, `YR = H` or `RZ = W` is !! required. integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of `MDG` should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( in ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Nb !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ip !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ir !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( inout ) :: x ( * ) !! `X(N)` !! !! *Input* With mode=2 or 3 this array contains, !! respectively, the right-side vectors H or W of !! the systems YR = H or RZ = W. !! !! *Output* This array contains the solution vectors `X`, !! `Y` or `Z` of the systems `AX = B`, `YR = H` or !! `RZ = W` depending on the value of `MODE`=1, !! 2 or 3. integer , intent ( in ) :: n !! The number of variables in the solution !! vector. If any of the `N` diagonal terms are !! zero the subroutine [[DBNDSL]] prints an !! appropriate message. This condition is !! considered an error. real ( wp ), intent ( out ) :: Rnorm !! If `MODE=1`, `RNORM` is the Euclidean length of the !! residual vector `AX-B`. When `MODE=2` or `3` RNORM` !! is set to zero. real ( wp ) :: rsq , s integer :: i , i1 , i2 , ie , ii , iopt , irm1 , ix , j , & jg , l , nerr , np1 real ( wp ), parameter :: zero = 0.0_wp main : block Rnorm = zero select case ( Mode ) case ( 1 ) ! ALG. STEP 26 do j = 1 , n x ( j ) = g ( j , Nb + 1 ) end do rsq = zero np1 = n + 1 irm1 = Ir - 1 if ( np1 <= irm1 ) then do j = np1 , irm1 rsq = rsq + g ( j , Nb + 1 ) ** 2 end do Rnorm = sqrt ( rsq ) end if case ( 2 ) do j = 1 , n s = zero if ( j /= 1 ) then i1 = max ( 1 , j - Nb + 1 ) i2 = j - 1 do i = i1 , i2 l = j - i + 1 + max ( 0 , i - Ip ) s = s + x ( i ) * g ( i , l ) end do end if l = max ( 0 , j - Ip ) if ( g ( j , l + 1 ) == 0 ) exit main x ( j ) = ( x ( j ) - s ) / g ( j , l + 1 ) end do return end select ! MODE = 3 do ii = 1 , n i = n + 1 - ii s = zero l = max ( 0 , i - Ip ) if ( i /= n ) then ie = min ( n + 1 - i , Nb ) do j = 2 , ie jg = j + l ix = i - 1 + j s = s + g ( i , jg ) * x ( ix ) end do end if if ( g ( i , l + 1 ) == 0 ) exit main x ( i ) = ( x ( i ) - s ) / g ( i , l + 1 ) end do return end block main ! error handling nerr = 1 iopt = 2 write ( * , * ) 'A zero diagonal term is in the n by n upper triangular matrix.' end subroutine dbndsl !***************************************************************************************** !***************************************************************************************** !> ! Calculates the value of all possibly nonzero B-splines at `X` of ! order `MAX(JHIGH,(J+1)(INDEX-1))` on `T`. ! !### Revision history ! * 780801 DATE WRITTEN ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * JW : made threadsafe. See also [[dbspvn]] subroutine dfspvn ( t , Jhigh , Index , x , Ileft , Vnikx , j , deltam , deltap ) real ( wp ), intent ( in ) :: t ( * ) integer , intent ( in ) :: Jhigh integer , intent ( in ) :: Index real ( wp ), intent ( in ) :: x integer , intent ( in ) :: Ileft real ( wp ) :: Vnikx ( * ) integer , intent ( inout ) :: j !! JW : added real ( wp ), dimension ( 20 ), intent ( inout ) :: deltam , deltap !! JW : added real ( wp ) :: vm , vmprev integer :: imjp1 , ipj , jp1 , jp1ml , l if ( Index /= 2 ) then j = 1 Vnikx ( 1 ) = 1.0_wp if ( j >= Jhigh ) return end if do ipj = Ileft + j deltap ( j ) = t ( ipj ) - x imjp1 = Ileft - j + 1 deltam ( j ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = j + 1 do l = 1 , j jp1ml = jp1 - l vm = Vnikx ( l ) / ( deltap ( l ) + deltam ( jp1ml )) Vnikx ( l ) = vm * deltap ( l ) + vmprev vmprev = vm * deltam ( jp1ml ) end do Vnikx ( jp1 ) = vmprev j = jp1 if ( j >= Jhigh ) exit end do end subroutine dfspvn !***************************************************************************************** !***************************************************************************************** !> ! Construction and/or application of a single ! Householder transformation. `Q = I + U*(U**T)/B` ! !### Reference ! ! * C.L.Lawson and R.J.Hanson, Jet Propulsion Laboratory, 1973 Jun 12 ! to appear in 'Solving Least Squares Problems', Prentice-Hall, 1974 ! !### Revision history ! * 790101 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 900911 Added DDOT to real(wp) statement. (WRB) subroutine dh12 ( Mode , Lpivot , l1 , m , u , Iue , Up , c , Ice , Icv , Ncv ) integer , intent ( in ) :: Mode !! 1 or 2 to select algorithm H1 or H2 . integer , intent ( in ) :: Lpivot !! the index of the pivot element. integer , intent ( in ) :: l1 !! If `L1 <= M` the transformation will be constructed to !! zero elements indexed from `L1` through `M`. If `L1 > M` !! the subroutine does an identity transformation. integer , intent ( in ) :: m !! see `l1` integer , intent ( in ) :: Iue !! the storage increment between elements of `U`. real ( wp ), intent ( inout ) :: u ( Iue , * ) !! On entry to H1 `U()` contains the pivot vector. !! On exit from H1 `U()` and `UP` !! contain quantities defining the vector `U` of the !! Householder transformation. On entry to H2 `U()` !! and `UP` should contain quantities previously computed !! by H1. These will not be modified by H2. real ( wp ), intent ( inout ) :: Up !! see `u` real ( wp ), intent ( inout ) :: c ( * ) !! On entry to H1 or H2 `C()` contains a matrix which will be !! regarded as a set of vectors to which the Householder !! transformation is to be applied. On exit `C()` contains the !! set of transformed vectors. integer , intent ( in ) :: Ice !! Storage increment between elements of vectors in `C()`. integer , intent ( in ) :: Icv !! Storage increment between vectors in `C()`. integer , intent ( in ) :: Ncv !! Number of vectors in `C()` to be transformed. If `NCV <= 0` !! no operations will be done on `C()`. integer :: i , i2 , i3 , i4 , incr , j , kl1 , & kl2 , klp , l1m1 , mml1p2 real ( wp ) :: b , cl , clinv , ul1m1 , sm real ( wp ), parameter :: one = 1.0_wp if ( 0 < Lpivot . and . Lpivot < l1 . and . l1 <= m ) then cl = abs ( u ( 1 , Lpivot )) if ( Mode /= 2 ) then ! ****** CONSTRUCT THE TRANSFORMATION. ****** do j = l1 , m cl = max ( abs ( u ( 1 , j )), cl ) end do if ( cl <= 0.0_wp ) return clinv = one / cl sm = ( u ( 1 , Lpivot ) * clinv ) ** 2 do j = l1 , m sm = sm + ( u ( 1 , j ) * clinv ) ** 2 end do cl = cl * sqrt ( sm ) if ( u ( 1 , Lpivot ) > 0.0_wp ) cl = - cl Up = u ( 1 , Lpivot ) - cl u ( 1 , Lpivot ) = cl ! ****** APPLY THE TRANSFORMATION I+U*(U**T)/B TO C. ****** elseif ( cl <= 0.0_wp ) then return end if if ( Ncv > 0 ) then b = Up * u ( 1 , Lpivot ) ! B MUST BE NONPOSITIVE HERE. IF B = 0., RETURN. if ( b < 0.0_wp ) then b = one / b mml1p2 = m - l1 + 2 if ( mml1p2 <= 20 ) then i2 = 1 - Icv + Ice * ( Lpivot - 1 ) incr = Ice * ( l1 - Lpivot ) do j = 1 , Ncv i2 = i2 + Icv i3 = i2 + incr i4 = i3 sm = c ( i2 ) * Up do i = l1 , m sm = sm + c ( i3 ) * u ( 1 , i ) i3 = i3 + Ice end do if ( sm /= 0.0_wp ) then sm = sm * b c ( i2 ) = c ( i2 ) + sm * Up do i = l1 , m c ( i4 ) = c ( i4 ) + sm * u ( 1 , i ) i4 = i4 + Ice end do end if end do else l1m1 = l1 - 1 kl1 = 1 + ( l1m1 - 1 ) * Ice kl2 = kl1 klp = 1 + ( Lpivot - 1 ) * Ice ul1m1 = u ( 1 , l1m1 ) u ( 1 , l1m1 ) = Up if ( Lpivot /= l1m1 ) call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) do j = 1 , Ncv sm = ddot ( mml1p2 , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) sm = sm * b call daxpy ( mml1p2 , sm , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) kl1 = kl1 + Icv end do u ( 1 , l1m1 ) = ul1m1 if ( Lpivot /= l1m1 ) then kl1 = kl2 call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) end if end if end if end if end if end subroutine dh12 !***************************************************************************************** !***************************************************************************************** !> ! Sort an array and optionally make the same interchanges in ! an auxiliary array. The array may be sorted in increasing ! or decreasing order. ! !### History ! * 29-dec-2022 : Replaced original routines. ! Now just a wraper for [[sort_ascending]] recursive quicksort (JW) subroutine dsort ( n , Kflag , Dx , Dy ) implicit none integer , intent ( in ) :: n !! number of values in array DX to be sorted integer , intent ( in ) :: Kflag !! control parameter: !! * Kflag < 0 : sort DX in decreasing order and optionally carry DY along. !! * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real ( wp ), dimension ( * ), intent ( inout ) :: Dx !! array of values to be sorted (usually abscissas) real ( wp ), dimension ( * ), intent ( inout ), optional :: Dy !! array to be (optionally) carried along if ( n < 1 ) then write ( * , * ) 'The number of values to be sorted is not positive.' return end if if ( abs ( Kflag ) == 0 ) then write ( * , * ) 'The sort control parameter, K, cannot be 0.' return end if ! Alter array DX to get decreasing order if needed if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) call sort_ascending ( n , Dx , Dy ) if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) end subroutine dsort !***************************************************************************************** !***************************************************************************************** !> ! Recursive quicksoft. ! Modified to also carry along a second array. ! !### Author ! * Jacob Williams subroutine sort_ascending ( n , dx , dy ) integer , intent ( in ) :: n real ( wp ), dimension ( * ), intent ( inout ) :: dx !! array of values to be sorted real ( wp ), dimension ( * ), intent ( inout ), optional :: dy !! array to be (optionally) carried along logical :: carry_dy !! if `dy` is to be also sorted integer , parameter :: max_size_for_insertion_sort = 20 !! max size for using insertion sort. !! (otherwise, use quicksort) carry_dy = present ( dy ) call quicksort ( 1 , n ) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array (ascending order). integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer :: ipivot !! pivot element integer :: i !! counter integer :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( dx ( j ) < dx ( j - 1 )) then call swap ( dx ( j ), dx ( j - 1 )) if ( carry_dy ) call swap ( dy ( j ), dy ( j - 1 )) else exit end if end do end do else if ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1 ) call quicksort ( ipivot + 1 , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer , intent ( out ) :: ipivot integer :: i , ip , im im = ( ilow + ihigh ) / 2 call swap ( dx ( ilow ), dx ( im )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( im )) ip = ilow do i = ilow + 1 , ihigh if ( dx ( i ) < dx ( ilow )) then ip = ip + 1 call swap ( dx ( ip ), dx ( i )) if ( carry_dy ) call swap ( dy ( ip ), dy ( i )) end if end do call swap ( dx ( ilow ), dx ( ip )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( ip )) ipivot = ip end subroutine partition subroutine swap ( v1 , v2 ) !! swap two real values real ( wp ), intent ( inout ) :: v1 real ( wp ), intent ( inout ) :: v2 real ( wp ) :: tmp tmp = v1 v1 = v2 v2 = tmp end subroutine swap end subroutine sort_ascending !***************************************************************************************** !***************************************************************************************** !> ! This subprogram fits a piecewise polynomial curve ! to discrete data. The piecewise polynomials are ! represented as B-splines. ! The fitting is done in a weighted least squares sense. ! Equality and inequality constraints can be imposed on the ! fitted curve. ! !### Evaluating the Variance Function ! ! To evaluate the variance function (assuming ! that the uncertainties of the Y values were ! provided to [[DFC]] and an input value of ! MODE=2 or 4 was used), use the function ! subprogram [[DCV]] ! !```fortran ! var = dcv(xval,ndata,nconst,nord,nbkpt, bkpt,w) !``` ! ! Here XVAL is the point where the variance is ! desired. The other arguments have the same ! meaning as in the usage of [[DFC]]. ! ! For those users employing the old problem ! designation, let MDATA be the number of data ! points in the problem. (This may be different ! from NDATA if the old problem designation ! feature was used.) The value, VAR, should be ! multiplied by the quantity ! ! `DBLE(MAX(NDATA-N,1))/DBLE(MAX(MDATA-N,1))` ! ! The output of this subprogram is not defined ! if an input value of MODE=1 or 3 was used in ! FC( ) or if an output value of MODE=-1, 2, or ! 3 was obtained. The variance function, except ! for the scaling factor noted above, is given ! by ! ! `VAR=(transpose of B(XVAL))*C*B(XVAL)` ! ! The vector B(XVAL) is the B-spline basis ! function values at X=XVAL. ! The covariance matrix, C, of the solution ! coefficients accounts only for the least ! squares equations and the explicitly stated ! equality constraints. This fact must be ! considered when interpreting the variance ! function from a data fitting problem that has ! inequality constraints on the fitted curve. ! !### Evaluating the Fitted Curve ! ! * Refer to the [[defc]] header ! !### Revision history ! * 780801 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900510 Convert references to XERRWV to references to XERMSG. (RWC) ! * 900607 Editorial changes to Prologue to make Prologues for EFC, ! DEFC, FC, and DFC look as much the same as possible. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dfc ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , & nconst , xconst , yconst , nderiv , mode , coeff , w , iw ) integer , intent ( in ) :: ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), intent ( in ) :: xdata ( * ) !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), intent ( in ) :: ydata ( * ) !! Y data array. real ( wp ), intent ( in ) :: sddata ( * ) !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension ( * ), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: nconst !! The number of conditions that constrain the !! B-spline is NCONST. A constraint is specified !! by an (X,Y) pair in the arrays XCONST(*) and !! YCONST(*), and by the type of constraint and !! derivative value encoded in the array !! NDERIV(*). real ( wp ), intent ( in ) :: xconst ( * ) !! X value of constraint. !! No sorting of XCONST(*) is required. real ( wp ), intent ( in ) :: yconst ( * ) !! Y value of constraint integer , intent ( in ) :: nderiv ( * ) !! The value of NDERIV(*) is !! determined as follows. Suppose the I-th !! constraint applies to the J-th derivative !! of the B-spline. (Any non-negative value of !! J < NORD is permitted. In particular the !! value J=0 refers to the B-spline itself.) !! For this I-th constraint, set !!``` !! XCONST(I)=X, !! YCONST(I)=Y, and !! NDERIV(I)=ITYPE+4*J, where !! !! ITYPE = 0, if (J-th deriv. at X) <= Y. !! = 1, if (J-th deriv. at X) >= Y. !! = 2, if (J-th deriv. at X) == Y. !! = 3, if (J-th deriv. at X) == !! (J-th deriv. at Y). !!``` !! (A value of NDERIV(I)=-1 will cause this !! constraint to be ignored. This subprogram !! feature is often useful when temporarily !! suppressing a constraint while still !! retaining the source code of the calling !! program.) integer , intent ( inout ) :: mode !! *Input* !! !! An input flag that directs the least squares !! solution method used by [[DFC]]. !! !! The variance function, referred to below, !! defines the square of the probable error of !! the fitted curve at any point, XVAL. !! This feature of [[DFC]] allows one to use the !! square root of this variance function to !! determine a probable error band around the !! fitted curve. !! !! * `=1` a new problem. No variance function. !! * `=2` a new problem. Want variance function. !! * `=3` an old problem. No variance function. !! * `=4` an old problem. Want variance function. !! !! Any value of MODE other than 1-4 is an error. !! !! The user with a new problem can skip directly !! to the description of the input parameters !! IW(1), IW(2). !! !! If the user correctly specifies the new or old !! problem status, the subprogram [[DFC]] will !! perform more efficiently. !! By an old problem it is meant that subprogram !! [[DFC]] was last called with this same set of !! knots, data points and weights. !! !! Another often useful deployment of this old !! problem designation can occur when one has !! previously obtained a Q-R orthogonal !! decomposition of the matrix resulting from !! B-spline fitting of data (without constraints) !! at the breakpoints BKPT(I), I=1,...,NBKPT. !! For example, this matrix could be the result !! of sequential accumulation of the least !! squares equations for a very large data set. !! The user writes this code in a manner !! convenient for the application. For the !! discussion here let !! !! `N=NBKPT-NORD, and K=N+3` !! !! Let us assume that an equivalent least squares !! system !! !! `RC=D` !! !! has been obtained. Here R is an N+1 by N !! matrix and D is a vector with N+1 components. !! The last row of R is zero. The matrix R is !! upper triangular and banded. At most NORD of !! the diagonals are nonzero. !! The contents of R and D can be copied to the !! working array W(*) as follows. !! !! The I-th diagonal of R, which has N-I+1 !! elements, is copied to W(*) starting at !! !! `W((I-1)*K+1),` !! !! for I=1,...,NORD. !! The vector D is copied to W(*) starting at !! !! `W(NORD*K+1)` !! !! The input value used for NDATA is arbitrary !! when an old problem is designated. Because !! of the feature of [[DFC]] that checks the !! working storage array lengths, a value not !! exceeding NBKPT should be used. For example, !! use NDATA=0. !! !! (The constraints or variance function request !! can change in each call to [[DFC]].) A new !! problem is anything other than an old problem. !! !! *Output* !! !! An output flag that indicates the status !! of the constrained curve fit. !! !! * `=-1` a usage error of [[DFC]] occurred. The !! offending condition is noted with the !! SLATEC library error processor, XERMSG. !! In case the working arrays W(*) or IW(*) !! are not long enough, the minimal !! acceptable length is printed. !! * `= 0` successful constrained curve fit. !! * `= 1` the requested equality constraints !! are contradictory. !! * `= 2` the requested inequality constraints !! are contradictory. !! * `= 3` both equality and inequality constraints !! are contradictory. real ( wp ), intent ( out ) :: coeff ( * ) !! If the output value of MODE=0 or 1, this array !! contains the unknowns obtained from the least !! squares fitting process. These N=NBKPT-NORD !! parameters are the B-spline coefficients. !! For MODE=1, the equality constraints are !! contradictory. To make the fitting process !! more robust, the equality constraints are !! satisfied in a least squares sense. In this !! case the array COEFF(*) contains B-spline !! coefficients for this extended concept of a !! solution. If MODE=-1,2 or 3 on output, the !! array COEFF(*) is undefined. real ( wp ) :: w ( * ) !! real work array of length `IW(1)`. The !! contents of `W(*)` must not be modified by the !! user if the variance function is desired. !! !! The length of W(*) must be at least !!``` !! NB=(NBKPT-NORD+3)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` !! Whenever possible the code uses banded matrix !! processors DBNDAC( ) and DBNDSL( ). These !! are utilized if there are no constraints, !! no variance function is required, and there !! is sufficient data to uniquely determine the !! B-spline coefficients. If the band processors !! cannot be used to determine the solution, !! then the constrained least squares code DLSEI !! is used. In this case the subprogram requires !! an additional block of storage in W(*). For !! the discussion here define the integers NEQCON !! and NINCON respectively as the number of !! equality (ITYPE=2,3) and inequality !! (ITYPE=0,1) constraints imposed on the fitted !! curve. Define !! !! `L = NBKPT-NORD+1` !! !! and note that !! !! `NCONST = NEQCON+NINCON` !! !! When the subprogram [[DFC]] uses [[DLSEI]] the !! length of the working array W(*) must be at !! least !! !! `LW = NB+(L+NCONST)*L+2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6)` integer :: iw ( * ) !! integer work array of length `IW(2)` !! !! `IW(1),IW(2)` are the amounts of working storage actually !! allocated for the working arrays W(*) and !! IW(*). These quantities are compared with the !! actual amounts of storage needed in [[DFC]]. !! Insufficient storage allocated for either !! W(*) or IW(*) is an error. This feature was !! included in [[DFC]] because misreading the !! storage formulas for W(*) and IW(*) might very !! well lead to subtle and hard-to-find !! programming bugs. !! !! The length of the array IW(*) must be at least !! !! `IW1 = NINCON+2*L` !! !! in any case. integer :: i1 , i2 , i3 , i4 , i5 , i6 , i7 , mdg , mdw mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst ! USAGE IN DFCMN( ) OF W(*).. ! I1,...,I2-1 G(*,*) ! I2,...,I3-1 XTEMP(*) ! I3,...,I4-1 PTEMP(*) ! I4,...,I5-1 BKPT(*) (LOCAL TO [[DFCMN]]) ! I5,...,I6-1 BF(*,*) ! I6,...,I7-1 W(*,*) ! I7,... WORK(*) FOR [[DLSEI]] i1 = 1 i2 = i1 + mdg * ( nord + 1 ) i3 = i2 + max ( ndata , nbkpt ) i4 = i3 + max ( ndata , nbkpt ) i5 = i4 + nbkpt i6 = i5 + nord * nord i7 = i6 + mdw * ( nbkpt - nord + 1 ) call dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , nconst , & xconst , yconst , nderiv , mode , coeff , w ( i5 ), w ( i2 ), w ( i3 ), & w ( i4 ), w ( i1 ), mdg , w ( i6 ), mdw , w ( i7 ), iw ) end subroutine dfc !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DFC]]. ! The documentation for [[DFC]] has complete usage instructions. ! !### Revision history ! * 780801 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900328 Added TYPE section. (WRB) ! * 900510 Convert XERRWV calls to XERMSG calls. (RWC) ! * 900604 DP version created from SP version. (RWC) subroutine dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , & bkptin , nconst , xconst , yconst , nderiv , mode , coeff , bf , xtemp , & ptemp , bkpt , g , mdg , w , mdw , work , iwork ) integer :: iwork ( * ), mdg , mdw , mode , nbkpt , nconst , ndata , nderiv ( * ), & nord real ( wp ) :: bf ( nord , * ), bkpt ( * ), bkptin ( * ), coeff ( * ), & g ( mdg , * ), ptemp ( * ), sddata ( * ), w ( mdw , * ), work ( * ), & xconst ( * ), xdata ( * ), xtemp ( * ), yconst ( * ), ydata ( * ) real ( wp ) :: prgopt ( 10 ), rnorm , rnorme , rnorml , xmax , & xmin , xval , yval integer :: i , idata , ideriv , ileft , intrvl , intw1 , ip , ir , irow , & itype , iw1 , iw2 , l , lw , mt , n , nb , neqcon , nincon , nordm1 , & nordp1 , np1 logical :: band , new , var character ( len = 8 ) :: xern1 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Analyze input. if ( nord < 1 . or . nord > 20 ) then write ( * , * ) 'IN DFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' mode = - 1 return elseif ( nbkpt < 2 * nord ) then write ( * , * ) 'IN DFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE ' // & 'THE B-SPLINE ORDER.' mode = - 1 return endif if ( ndata < 0 ) then write ( * , * ) 'IN DFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' mode = - 1 return endif ! Amount of storage allocated for W(*), IW(*). iw1 = iwork ( 1 ) iw2 = iwork ( 2 ) nb = ( nbkpt - nord + 3 ) * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + & nord ** 2 ! See if sufficient storage has been allocated. if ( iw1 < nb ) then write ( xern1 , '(I8)' ) nb write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK NB = ' // xern1 mode = - 1 return endif select case ( mode ) case ( 1 ) band = . true . var = . false . new = . true . case ( 2 ) band = . false . var = . true . new = . true . case ( 3 ) band = . true . var = . false . new = . false . case ( 4 ) band = . false . var = . true . new = . false . case default write ( * , * ) 'IN DFC, INPUT VALUE OF MODE MUST BE 1-4.' mode = - 1 return end select mode = 0 ! Sort the breakpoints. call dcopy ( nbkpt , bkptin , 1 , bkpt , 1 ) call dsort ( nbkpt , 1 , bkpt ) ! Initialize variables. neqcon = 0 nincon = 0 do i = 1 , nconst l = nderiv ( i ) itype = mod ( l , 4 ) if ( itype < 2 ) then nincon = nincon + 1 else neqcon = neqcon + 1 endif end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Compute the number of variables. n = nbkpt - nord np1 = n + 1 lw = nb + ( np1 + nconst ) * np1 + 2 * ( neqcon + np1 ) + ( nincon + np1 ) + & ( nincon + 2 ) * ( np1 + 6 ) intw1 = nincon + 2 * np1 ! Save interval containing knots. xmin = bkpt ( nord ) xmax = bkpt ( np1 ) ! Find the smallest referenced independent variable value in any ! constraint. do i = 1 , nconst xmin = min ( xmin , xconst ( i )) xmax = max ( xmax , xconst ( i )) end do nordm1 = nord - 1 nordp1 = nord + 1 ! Define the option vector PRGOPT(1-10) for use in [[DLSEI]]. prgopt ( 1 ) = 4 ! Set the covariance matrix computation flag. prgopt ( 2 ) = 1 if ( var ) then prgopt ( 3 ) = 1 else prgopt ( 3 ) = 0 endif ! Increase the rank determination tolerances for both equality ! constraint equations and least squares equations. prgopt ( 4 ) = 7 prgopt ( 5 ) = 4 prgopt ( 6 ) = 1.0e-4_wp prgopt ( 7 ) = 10 prgopt ( 8 ) = 5 prgopt ( 9 ) = 1.0e-4_wp prgopt ( 10 ) = 1 ! Turn off work array length checking in [[DLSEI]]. iwork ( 1 ) = 0 iwork ( 2 ) = 0 ! Initialize variables and analyze input. if ( new ) then ! To process least squares equations sort data and an array of ! pointers. call dcopy ( ndata , xdata , 1 , xtemp , 1 ) do i = 1 , ndata ptemp ( i ) = i end do if ( ndata > 0 ) then call dsort ( ndata , 2 , xtemp , ptemp ) xmin = min ( xmin , xtemp ( 1 )) xmax = max ( xmax , xtemp ( ndata )) endif ! Fix breakpoint array if needed. do i = 1 , nord bkpt ( i ) = min ( bkpt ( i ), xmin ) end do do i = np1 , nbkpt bkpt ( i ) = max ( bkpt ( i ), xmax ) end do ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = nord do idata = 1 , ndata ! Sorted indices are in PTEMP(*). l = ptemp ( idata ) xval = xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= bkpt ( ileft + 1 )) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ! ILEFT= bkpt ( ileft + 1 ) . and . ileft < n ) then ileft = ileft + 1 else exit endif end do endif ! Obtain B-spline function value. call dfspvn ( bkpt , nord , 1 , xval , ileft , bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( nord , bf , 1 , g ( irow , 1 ), mdg ) g ( irow , nordp1 ) = ydata ( l ) ! Scale data if uncertainty is nonzero. if ( sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / sddata ( l ), & g ( irow , 1 ), mdg ) ! When staging work area is exhausted, process rows. if ( irow == mdg - 1 ) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 endif end do ! Process last block of equations. call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), mdg ) call dbndac ( g , mdg , nord , ip , ir , 1 , np1 ) endif band = band . and . nconst == 0 do i = 1 , n band = band . and . g ( i , 1 ) /= 0.0_wp end do ! Process banded least squares equations. if ( band ) then call dbndsl ( 1 , g , mdg , nord , ip , ir , coeff , n , rnorm ) return endif ! Check further for sufficient storage in working arrays. if ( iw1 < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK LW = ' // xern1 mode = - 1 return endif if ( iw2 < intw1 ) then write ( xern1 , '(I8)' ) intw1 write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR IW(*). CHECK IW1 = ' // xern1 mode = - 1 return endif ! Write equality constraints. ! Analyze constraint indicators for an equality constraint. neqcon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype > 1 ) then ideriv = l / 4 neqcon = neqcon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) call dcopy ( np1 , [ 0.0_wp ], 0 , w ( neqcon , 1 ), mdw ) call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( neqcon , ileft - nordm1 ), & mdw ) if ( itype == 2 ) then w ( neqcon , np1 ) = yconst ( idata ) else ileft = nord yval = yconst ( idata ) do if ( yval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , yval , ileft , bf , ideriv + 1 ) call daxpy ( nord , - 1.0_wp , bf ( 1 , ideriv + 1 ), 1 , & w ( neqcon , ileft - nordm1 ), mdw ) endif endif end do ! Transfer least squares data. do i = 1 , np1 irow = i + neqcon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) call dcopy ( min ( np1 - i , nord ), g ( i , 1 ), mdg , w ( irow , i ), mdw ) w ( irow , np1 ) = g ( i , nordp1 ) end do ! Write inequality constraints. ! Analyze constraint indicators for inequality constraints. nincon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype < 2 ) then ideriv = l / 4 nincon = nincon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) irow = neqcon + np1 + nincon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) intrvl = ileft - nordm1 call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( irow , intrvl ), mdw ) if ( itype == 1 ) then w ( irow , np1 ) = yconst ( idata ) else w ( irow , np1 ) = - yconst ( idata ) call dscal ( nord , - 1.0_wp , w ( irow , intrvl ), mdw ) endif endif end do ! Solve constrained least squares equations. call dlsei ( w , mdw , neqcon , np1 , nincon , n , prgopt , coeff , rnorme , & rnorml , mode , work , iwork ) end subroutine dfcmn !***************************************************************************************** !***************************************************************************************** !> ! Calculates value and derivs of all B-splines which do not vanish at `X` ! ! Fill `VNIKX(J,IDERIV), J=IDERIV, ... ,K` with nonzero values of ! B-splines of order `K+1-IDERIV , IDERIV=NDERIV, ... ,1`, by repeated ! calls to [[DFSPVN]] ! !### Revision history ! * 780801 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 890911 Removed unnecessary intrinsics. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) subroutine dfspvd ( t , k , x , ileft , vnikx , nderiv ) real ( wp ) :: t ( * ) integer :: k real ( wp ) :: x integer :: ileft real ( wp ) :: vnikx ( k , * ) integer :: nderiv real ( wp ) :: a ( 20 , 20 ) integer :: ideriv , idervm , i , j , kmd , m , jm1 , ipkmd , l , jlow real ( wp ) :: fkmd , diff , v integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp call dfspvn ( t , k + 1 - nderiv , 1 , x , ileft , vnikx ( nderiv , nderiv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) if ( nderiv <= 1 ) return ideriv = nderiv do i = 2 , nderiv idervm = ideriv - 1 do j = ideriv , k vnikx ( j - 1 , idervm ) = vnikx ( j , ideriv ) end do ideriv = idervm call dfspvn ( t , 0 , 2 , x , ileft , vnikx ( ideriv , ideriv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) end do do i = 1 , k do j = 1 , k a ( i , j ) = 0.0_wp end do a ( i , i ) = 1.0_wp end do kmd = k do m = 2 , nderiv kmd = kmd - 1 fkmd = kmd i = ileft j = k do jm1 = j - 1 ipkmd = i + kmd diff = t ( ipkmd ) - t ( i ) if ( jm1 == 0 ) exit if ( diff /= 0.0_wp ) then do l = 1 , j a ( l , j ) = ( a ( l , j ) - a ( l , j - 1 )) / diff * fkmd end do end if j = jm1 i = i - 1 end do if ( diff /= 0.0_wp ) then a ( 1 , 1 ) = a ( 1 , 1 ) / diff * fkmd end if do i = 1 , k v = 0.0_wp jlow = max ( i , m ) do j = jlow , k v = a ( i , j ) * vnikx ( j , m ) + v end do vnikx ( i , m ) = v end do end do end subroutine dfspvd !***************************************************************************************** !***************************************************************************************** !> ! Solve a least squares problem for banded matrices using ! sequential accumulation of rows of the data matrix. ! Exactly one right-hand side vector is permitted. ! ! This subroutine solves a linear least squares problem or a set of ! linear least squares problems having the same matrix but different ! right-side vectors. The problem data consists of an M by N matrix ! A, an M by NB matrix B, and an absolute tolerance parameter TAU ! whose usage is described below. The NB column vectors of B ! represent right-side vectors for NB distinct linear least squares ! problems. ! ! This set of problems can also be written as the matrix least ! squares problem ! ! `A = B`, ! ! where X is the N by NB solution matrix. ! ! Note that if B is the M by M identity matrix, then X will be the ! pseudo-inverse of A. ! ! This subroutine first transforms the augmented matrix (A B) to a ! matrix (R C) using premultiplying Householder transformations with ! column interchanges. All subdiagonal elements in the matrix R are ! zero and its diagonal elements satisfy ! !``` ! abs(r(i,i))>=abs(r(i+1,i+1)), ! i = 1,...,l-1, where ! l = min(m,n). !``` ! ! The subroutine will compute an integer, KRANK, equal to the number ! of diagonal terms of R that exceed TAU in magnitude. Then a ! solution of minimum Euclidean length is computed using the first ! KRANK rows of (R C). ! ! To be specific we suggest that the user consider an easily ! computable matrix norm, such as, the maximum of all column sums of ! magnitudes. ! ! Now if the relative uncertainty of B is EPS, (norm of uncertainty/ ! norm of B), it is suggested that TAU be set approximately equal to ! EPS*(norm of A). ! !### References ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974, Chapter 14. ! !### Revision history ! * 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 901005 Replace usage of DDIFF with usage of D1MACH. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dhfti ( a , mda , m , n , b , mdb , nb , tau , krank , rnorm , h , g , ip ) integer , intent ( in ) :: mda !! actual leading dimension of `a` integer , intent ( in ) :: mdb !! actual leading dimension of `b` real ( wp ), intent ( inout ) :: a ( mda , * ) !! `A(MDA,N)`. !! The array A(*,*) initially contains the M by N !! matrix A of the least squares problem AX = B. !! The first dimensioning parameter of the array !! A(*,*) is MDA, which must satisfy MDA>=M !! Either M>=N or M0 !! the array B(*) must initially contain the M by !! NB matrix B of the least squares problem AX = !! B. If NB>=2 the array B(*) must be doubly !! subscripted with first dimensioning parameter !! MDB>=MAX(M,N). If NB = 1 the array B(*) may !! be either doubly or singly subscripted. In !! the latter case the value of MDB is arbitrary !! but it should be set to some valid integer !! value such as MDB = M. !! !! The condition of NB>1.AND.MDB< MAX(M,N) !! is considered an error. !! !! On return the array B(*) will contain the N by !! NB solution matrix X. integer , intent ( in ) :: nb real ( wp ), intent ( in ) :: tau !! Absolute tolerance parameter provided by user !! for pseudorank determination. integer , intent ( out ) :: krank !! Set by the subroutine to indicate the !! pseudorank of A. real ( wp ), intent ( out ) :: rnorm ( * ) !! `RNORM(NB)`. !! On return, RNORM(J) will contain the Euclidean !! norm of the residual vector for the problem !! defined by the J-th column vector of the array !! B(*,*) for J = 1,...,NB. real ( wp ) :: h ( * ) !! `H(N)`. Array of working space used by DHFTI. !! On return, contains !! elements of the pre-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. real ( wp ) :: g ( * ) !! `G(N)`. Array of working space used by DHFTI. !! On return, contain !! elements of the post-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. integer :: ip ( * ) !! `IP(N)`. Array of working space used by DHFTI. !! Array in which the subroutine records indices !! describing the permutation of column vectors. !! not generally required by the user. integer :: i , ii , iopt , ip1 , j , jb , jj , k , kp1 , l , ldiag , lmax , nerr real ( wp ) :: dzero , factor , hmax , sm , sm1 , szero , tmp logical :: lmax_found szero = 0.0_wp dzero = 0.0_wp factor = 0.001_wp k = 0 ldiag = min ( m , n ) if ( ldiag > 0 ) then if ( mda < m ) then nerr = 1 iopt = 2 write ( * , * ) 'MDA 1 . and . max ( m , n ) > mdb ) then nerr = 2 iopt = 2 write ( * , * ) 'MDB1. PROBABLE ERROR.' return end if do j = 1 , ldiag lmax_found = . false . if ( j /= 1 ) then ! UPDATE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = h ( l ) - a ( j - 1 , l ) ** 2 if ( h ( l ) > h ( lmax )) lmax = l end do lmax_found = ( factor * h ( lmax ) > hmax * drelpr ) end if if (. not . lmax_found ) then ! COMPUTE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = 0.0_wp do i = j , m h ( l ) = h ( l ) + a ( i , l ) ** 2 end do if ( h ( l ) > h ( lmax )) lmax = l end do hmax = h ( lmax ) end if ! LMAX HAS BEEN DETERMINED ! DO COLUMN INTERCHANGES IF NEEDED. ip ( j ) = lmax if ( ip ( j ) /= j ) then do i = 1 , m tmp = a ( i , j ) a ( i , j ) = a ( i , lmax ) a ( i , lmax ) = tmp end do h ( lmax ) = h ( j ) end if ! COMPUTE THE J-TH TRANSFORMATION AND APPLY IT TO A ! AND B. call dh12 ( 1 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), a ( 1 , j + 1 ), 1 , mda , n - j ) call dh12 ( 2 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), b , 1 , mdb , nb ) end do ! DETERMINE THE PSEUDORANK, K, USING THE TOLERANCE, TAU. do j = 1 , ldiag if ( abs ( a ( j , j )) <= tau ) then k = j - 1 exit else if ( j == ldiag ) k = ldiag end if end do kp1 = k + 1 ! COMPUTE THE NORMS OF THE RESIDUAL VECTORS. if ( nb >= 1 ) then do jb = 1 , nb tmp = szero if ( m >= kp1 ) then do i = kp1 , m tmp = tmp + b ( i , jb ) ** 2 end do end if rnorm ( jb ) = sqrt ( tmp ) end do end if ! SPECIAL FOR PSEUDORANK = 0 if ( k > 0 ) then ! IF THE PSEUDORANK IS LESS THAN N COMPUTE HOUSEHOLDER ! DECOMPOSITION OF FIRST K ROWS. if ( k /= n ) then do ii = 1 , k i = kp1 - ii call dh12 ( 1 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), a , mda , 1 , i - 1 ) end do end if if ( nb >= 1 ) then do jb = 1 , nb ! SOLVE THE K BY K TRIANGULAR SYSTEM. do l = 1 , k sm = dzero i = kp1 - l ip1 = i + 1 if ( k >= ip1 ) then do j = ip1 , k sm = sm + a ( i , j ) * b ( j , jb ) end do end if sm1 = sm b ( i , jb ) = ( b ( i , jb ) - sm1 ) / a ( i , i ) end do ! COMPLETE COMPUTATION OF SOLUTION VECTOR. if ( k /= n ) then do j = kp1 , n b ( j , jb ) = szero end do do i = 1 , k call dh12 ( 2 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), b ( 1 , jb ), 1 , mdb , 1 ) end do end if ! RE-ORDER THE SOLUTION VECTOR TO COMPENSATE FOR THE ! COLUMN INTERCHANGES. do jj = 1 , ldiag j = ldiag + 1 - jj if ( ip ( j ) /= j ) then l = ip ( j ) tmp = b ( l , jb ) b ( l , jb ) = b ( j , jb ) b ( j , jb ) = tmp end if end do end do end if elseif ( nb >= 1 ) then do jb = 1 , nb do i = 1 , n b ( i , jb ) = szero end do end do end if end if ! THE SOLUTION VECTORS, X, ARE NOW ! IN THE FIRST N ROWS OF THE ARRAY B(,). krank = k end subroutine dhfti !***************************************************************************************** !***************************************************************************************** !> ! Determine an N1-vector W, and ! an N2-vector Z ! which minimizes the Euclidean length of W ! subject to G*W+H*Z >= Y. ! This is the least projected distance problem, LPDP. ! The matrices G and H are of respective ! dimensions M by N1 and M by N2. ! ! Called by subprogram [[DLSI]]. ! !``` ! The matrix ! (G H Y) ! ! occupies rows 1,...,M and cols 1,...,N1+N2+1 of A(*,*). ! ! The solution (W) is returned in X(*). ! (Z) !``` ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 910408 Updated the AUTHOR section. (WRB) subroutine dlpdp ( a , mda , m , n1 , n2 , prgopt , x , wnorm , mode , ws , is ) integer , intent ( in ) :: mda integer :: m integer , intent ( in ) :: n1 integer , intent ( in ) :: n2 real ( wp ) :: a ( mda , * ) !! `A(MDA,N+1)`, where `N=N1+N2`. real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) !! `X(N)`, where `N=N1+N2`. real ( wp ) :: wnorm integer , intent ( out ) :: mode !! The value of MODE indicates the status of !! the computation after returning to the user. !! !! * `MODE=1` The solution was successfully obtained. !! * `MODE=2` The inequalities are inconsistent. real ( wp ) :: ws ( * ) !! `WS((M+2)*(N+7))`, where `N=N1+N2`. This is a slight overestimate for WS(*). integer :: is ( * ) !! `IS(M+N+1)`, where `N=N1+N2`. integer :: i , iw , ix , j , l , modew , n , np1 real ( wp ) :: rnorm , sc , ynorm real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: fac = 0.1_wp n = n1 + n2 mode = 1 if ( m <= 0 ) then if ( n > 0 ) then x ( 1 ) = zero call dcopy ( n , x , 0 , x , 1 ) end if wnorm = zero return end if np1 = n + 1 ! SCALE NONZERO ROWS OF INEQUALITY MATRIX TO HAVE LENGTH ONE. do i = 1 , m sc = dnrm2 ( n , a ( i , 1 ), mda ) if ( sc /= zero ) then sc = one / sc call dscal ( np1 , sc , a ( i , 1 ), mda ) end if end do ! SCALE RT.-SIDE VECTOR TO HAVE LENGTH ONE (OR ZERO). ynorm = dnrm2 ( m , a ( 1 , np1 ), 1 ) if ( ynorm /= zero ) then sc = one / ynorm call dscal ( m , sc , a ( 1 , np1 ), 1 ) end if ! SCALE COLS OF MATRIX H. j = n1 + 1 do if ( j > n ) exit sc = dnrm2 ( m , a ( 1 , j ), 1 ) if ( sc /= zero ) sc = one / sc call dscal ( m , sc , a ( 1 , j ), 1 ) x ( j ) = sc j = j + 1 end do if ( n1 > 0 ) then ! COPY TRANSPOSE OF (H G Y) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m ! MOVE COL OF TRANSPOSE OF H INTO WORK ARRAY. call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ! MOVE COL OF TRANSPOSE OF G INTO WORK ARRAY. call dcopy ( n1 , a ( i , 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n1 ! MOVE COMPONENT OF VECTOR Y INTO WORK ARRAY. ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n ws ( iw + 1 ) = one iw = iw + 1 ! SOLVE EU=F SUBJECT TO (TRANSPOSE OF H)U=0, U>=0. THE ! MATRIX E = TRANSPOSE OF (G Y), AND THE (N+1)-VECTOR ! F = TRANSPOSE OF (0,...,0,1). ix = iw + 1 iw = iw + m ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , np1 , n2 , np1 - n2 , m , 0 , prgopt , ws ( ix ), rnorm , & modew , is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY W. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n1 x ( j ) = sc * ddot ( m , a ( 1 , j ), 1 , ws ( ix ), 1 ) end do ! COMPUTE THE VECTOR Q=Y-GW. OVERWRITE Y WITH THIS ! VECTOR. do i = 1 , m a ( i , np1 ) = a ( i , np1 ) - ddot ( n1 , a ( i , 1 ), mda , x , 1 ) end do end if if ( n2 > 0 ) then ! COPY TRANSPOSE OF (H Q) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n2 , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = one iw = iw + 1 ix = iw + 1 iw = iw + m ! SOLVE RV=S SUBJECT TO V>=0. THE MATRIX R =(TRANSPOSE ! OF (H Q)), WHERE Q=Y-GW. THE (N2+1)-VECTOR S =(TRANSPOSE ! OF (0,...,0,1)). ! ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , n2 + 1 , 0 , n2 + 1 , m , 0 , prgopt , ws ( ix ), rnorm , modew , & is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY Z. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n2 l = n1 + j x ( l ) = sc * ddot ( m , a ( 1 , l ), 1 , ws ( ix ), 1 ) * x ( l ) end do end if ! ACCOUNT FOR SCALING OF RT.-SIDE VECTOR IN SOLUTION. call dscal ( n , ynorm , x , 1 ) wnorm = dnrm2 ( n1 , x , 1 ) end subroutine dlpdp !***************************************************************************************** !***************************************************************************************** !> ! This subprogram solves a linearly constrained least squares ! problem with both equality and inequality constraints, and, if the ! user requests, obtains a covariance matrix of the solution ! parameters. ! ! Suppose there are given matrices E, A and G of respective ! dimensions ME by N, MA by N and MG by N, and vectors F, B and H of ! respective lengths ME, MA and MG. This subroutine solves the ! linearly constrained least squares problem ! ! * `EX = F, (E ME by N)` (equations to be exactly satisfied) ! * `AX = B, (A MA by N)` (equations to be approximately satisfied, least squares sense) ! * `GX >= H,(G MG by N)` (inequality constraints) ! ! The inequalities GX >= H mean that every component of the ! product GX must be >= the corresponding component of H. ! ! In case the equality constraints cannot be satisfied, a ! generalized inverse solution residual vector length is obtained ! for F-EX. This is the minimal length possible for F-EX. ! ! Any values ME >= 0, MA >= 0, or MG >= 0 are permitted. The ! rank of the matrix E is estimated during the computation. We call ! this value KRANKE. It is an output parameter in IP(1) defined ! below. Using a generalized inverse solution of EX=F, a reduced ! least squares problem with inequality constraints is obtained. ! The tolerances used in these tests for determining the rank ! of E and the rank of the reduced least squares problem are ! given in Sandia Tech. Rept. SAND-78-1290. They can be ! modified by the user if new values are provided in ! the option list of the array PRGOPT(*). ! ! The user must dimension all arrays appearing in the call list.. ! W(MDW,N+1),PRGOPT(*),X(N),WS(2*(ME+N)+K+(MG+2)*(N+7)),IP(MG+2*N+2) ! where K=MAX(MA+MG,N). This allows for a solution of a range of ! problems in the given working space. The dimension of WS(*) ! given is a necessary overestimate. Once a particular problem ! has been run, the output parameter IP(3) gives the actual ! dimension required for that problem. ! ! The parameters for [[DLSEI]] are ! !``` ! Input.. All TYPE REAL variables are DOUBLE PRECISION ! ! W(*,*),MDW, The array W(*,*) is doubly subscripted with ! ME,MA,MG,N first dimensioning parameter equal to MDW. ! For this discussion let us call M = ME+MA+MG. Then ! MDW must satisfy MDW >= M. The condition ! MDW < M is an error. ! ! The array W(*,*) contains the matrices and vectors ! ! (E F) ! (A B) ! (G H) ! ! in rows and columns 1,...,M and 1,...,N+1 ! respectively. ! ! The integers ME, MA, and MG are the ! respective matrix row dimensions ! of E, A and G. Each matrix has N columns. ! ! PRGOPT(*) This real-valued array is the option vector. ! If the user is satisfied with the nominal ! subprogram features set ! ! PRGOPT(1)=1 (or PRGOPT(1)=1.0) ! ! Otherwise PRGOPT(*) is a linked list consisting of ! groups of data of the following form ! ! LINK ! KEY ! DATA SET ! ! The parameters LINK and KEY are each one word. ! The DATA SET can be comprised of several words. ! The number of items depends on the value of KEY. ! The value of LINK points to the first ! entry of the next group of data within ! PRGOPT(*). The exception is when there are ! no more options to change. In that ! case, LINK=1 and the values KEY and DATA SET ! are not referenced. The general layout of ! PRGOPT(*) is as follows. ! ! ...PRGOPT(1) = LINK1 (link to first entry of next group) ! . PRGOPT(2) = KEY1 (key to the option change) ! . PRGOPT(3) = data value (data value for this change) ! . . ! . . ! . . ! ...PRGOPT(LINK1) = LINK2 (link to the first entry of ! . next group) ! . PRGOPT(LINK1+1) = KEY2 (key to the option change) ! . PRGOPT(LINK1+2) = data value ! ... . ! . . ! . . ! ...PRGOPT(LINK) = 1 (no more options to change) ! ! Values of LINK that are nonpositive are errors. ! A value of LINK > NLINK=100000 is also an error. ! This helps prevent using invalid but positive ! values of LINK that will probably extend ! beyond the program limits of PRGOPT(*). ! Unrecognized values of KEY are ignored. The ! order of the options is arbitrary and any number ! of options can be changed with the following ! restriction. To prevent cycling in the ! processing of the option array, a count of the ! number of options changed is maintained. ! Whenever this count exceeds NOPT=1000, an error ! message is printed and the subprogram returns. ! ! Options.. ! ! KEY=1 ! Compute in W(*,*) the N by N ! covariance matrix of the solution variables ! as an output parameter. Nominally the ! covariance matrix will not be computed. ! (This requires no user input.) ! The data set for this option is a single value. ! It must be nonzero when the covariance matrix ! is desired. If it is zero, the covariance ! matrix is not computed. When the covariance matrix ! is computed, the first dimensioning parameter ! of the array W(*,*) must satisfy MDW >= MAX(M,N). ! ! KEY=10 ! Suppress scaling of the inverse of the ! normal matrix by the scale factor RNORM**2/ ! MAX(1, no. of degrees of freedom). This option ! only applies when the option for computing the ! covariance matrix (KEY=1) is used. With KEY=1 and ! KEY=10 used as options the unscaled inverse of the ! normal matrix is returned in W(*,*). ! The data set for this option is a single value. ! When it is nonzero no scaling is done. When it is ! zero scaling is done. The nominal case is to do ! scaling so if option (KEY=1) is used alone, the ! matrix will be scaled on output. ! ! KEY=2 ! Scale the nonzero columns of the ! entire data matrix. ! (E) ! (A) ! (G) ! ! to have length one. The data set for this ! option is a single value. It must be ! nonzero if unit length column scaling ! is desired. ! ! KEY=3 ! Scale columns of the entire data matrix ! (E) ! (A) ! (G) ! ! with a user-provided diagonal matrix. ! The data set for this option consists ! of the N diagonal scaling factors, one for ! each matrix column. ! ! KEY=4 ! Change the rank determination tolerance for ! the equality constraint equations from ! the nominal value of SQRT(DRELPR). This quantity can ! be no smaller than DRELPR, the arithmetic- ! storage precision. The quantity DRELPR is the ! largest positive number such that T=1.+DRELPR ! satisfies T == 1. The quantity used ! here is internally restricted to be at ! least DRELPR. The data set for this option ! is the new tolerance. ! ! KEY=5 ! Change the rank determination tolerance for ! the reduced least squares equations from ! the nominal value of SQRT(DRELPR). This quantity can ! be no smaller than DRELPR, the arithmetic- ! storage precision. The quantity used ! here is internally restricted to be at ! least DRELPR. The data set for this option ! is the new tolerance. ! ! For example, suppose we want to change ! the tolerance for the reduced least squares ! problem, compute the covariance matrix of ! the solution parameters, and provide ! column scaling for the data matrix. For ! these options the dimension of PRGOPT(*) ! must be at least N+9. The Fortran statements ! defining these options would be as follows: ! ! PRGOPT(1)=4 (link to entry 4 in PRGOPT(*)) ! PRGOPT(2)=1 (covariance matrix key) ! PRGOPT(3)=1 (covariance matrix wanted) ! ! PRGOPT(4)=7 (link to entry 7 in PRGOPT(*)) ! PRGOPT(5)=5 (least squares equas. tolerance key) ! PRGOPT(6)=... (new value of the tolerance) ! ! PRGOPT(7)=N+9 (link to entry N+9 in PRGOPT(*)) ! PRGOPT(8)=3 (user-provided column scaling key) ! ! CALL DCOPY (N, D, 1, PRGOPT(9), 1) (Copy the N ! scaling factors from the user array D(*) ! to PRGOPT(9)-PRGOPT(N+8)) ! ! PRGOPT(N+9)=1 (no more options to change) ! ! The contents of PRGOPT(*) are not modified ! by the subprogram. ! The options for WNNLS( ) can also be included ! in this array. The values of KEY recognized ! by WNNLS( ) are 6, 7 and 8. Their functions ! are documented in the usage instructions for ! subroutine WNNLS( ). Normally these options ! do not need to be modified when using [[DLSEI]]. ! ! IP(1), The amounts of working storage actually ! IP(2) allocated for the working arrays WS(*) and ! IP(*), respectively. These quantities are ! compared with the actual amounts of storage ! needed by [[DLSEI]]. Insufficient storage ! allocated for either WS(*) or IP(*) is an ! error. This feature was included in [[DLSEI]] ! because miscalculating the storage formulas ! for WS(*) and IP(*) might very well lead to ! subtle and hard-to-find execution errors. ! ! The length of WS(*) must be at least ! ! LW = 2*(ME+N)+K+(MG+2)*(N+7) ! ! where K = max(MA+MG,N) ! This test will not be made if IP(1)<=0. ! ! The length of IP(*) must be at least ! ! LIP = MG+2*N+2 ! This test will not be made if IP(2)<=0. ! ! Output.. All TYPE REAL variables are DOUBLE PRECISION ! ! X(*),RNORME, The array X(*) contains the solution parameters ! RNORML if the integer output flag MODE = 0 or 1. ! The definition of MODE is given directly below. ! When MODE = 0 or 1, RNORME and RNORML ! respectively contain the residual vector ! Euclidean lengths of F - EX and B - AX. When ! MODE=1 the equality constraint equations EX=F ! are contradictory, so RNORME /= 0. The residual ! vector F-EX has minimal Euclidean length. For ! MODE >= 2, none of these parameters is defined. ! ! MODE Integer flag that indicates the subprogram ! status after completion. If MODE >= 2, no ! solution has been computed. ! ! MODE = ! ! 0 Both equality and inequality constraints ! are compatible and have been satisfied. ! ! 1 Equality constraints are contradictory. ! A generalized inverse solution of EX=F was used ! to minimize the residual vector length F-EX. ! In this sense, the solution is still meaningful. ! ! 2 Inequality constraints are contradictory. ! ! 3 Both equality and inequality constraints ! are contradictory. ! ! The following interpretation of ! MODE=1,2 or 3 must be made. The ! sets consisting of all solutions ! of the equality constraints EX=F ! and all vectors satisfying GX >= H ! have no points in common. (In ! particular this does not say that ! each individual set has no points ! at all, although this could be the ! case.) ! ! 4 Usage error occurred. The value ! of MDW is < ME+MA+MG, MDW is ! < N and a covariance matrix is ! requested, or the option vector ! PRGOPT(*) is not properly defined, ! or the lengths of the working arrays ! WS(*) and IP(*), when specified in ! IP(1) and IP(2) respectively, are not ! long enough. ! ! W(*,*) The array W(*,*) contains the N by N symmetric ! covariance matrix of the solution parameters, ! provided this was requested on input with ! the option vector PRGOPT(*) and the output ! flag is returned with MODE = 0 or 1. ! ! IP(*) The integer working array has three entries ! that provide rank and working array length ! information after completion. ! ! IP(1) = rank of equality constraint ! matrix. Define this quantity ! as KRANKE. ! ! IP(2) = rank of reduced least squares ! problem. ! ! IP(3) = the amount of storage in the ! working array WS(*) that was ! actually used by the subprogram. ! The formula given above for the length ! of WS(*) is a necessary overestimate. ! If exactly the same problem matrices ! are used in subsequent executions, ! the declared dimension of WS(*) can ! be reduced to this output value. ! User Designated ! Working Arrays.. ! ! WS(*),IP(*) These are respectively type real ! and type integer working arrays. ! Their required minimal lengths are ! given above. !``` ! !### References ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Report SAND77-0552, Sandia ! Laboratories, June 1978. ! * K. H. Haskell and R. J. Hanson, Selected algorithms for ! the linearly constrained least squares problem - a ! users guide, Report SAND78-1290, Sandia Laboratories, ! August 1979. ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Mathematical Programming ! 21 (1981), pp. 98-118. ! * R. J. Hanson and K. H. Haskell, Two algorithms for the ! linearly constrained least squares problem, ACM ! Transactions on Mathematical Software, September 1982. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 890831 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900510 Convert XERRWV calls to XERMSG calls. (RWC) ! * 900604 DP version created from SP version. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dlsei ( w , mdw , me , ma , mg , n , prgopt , x , rnorme , & rnorml , mode , ws , ip ) integer , intent ( in ) :: mdw real ( wp ) :: w ( mdw , * ) integer :: me integer :: ma integer :: mg integer :: n real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) real ( wp ) :: rnorme real ( wp ) :: rnorml integer :: mode real ( wp ) :: ws ( * ) integer :: ip ( 3 ) real ( wp ) :: enorm , fnorm , gam , rb , rn , rnmax , size , & sn , snmax , t , tau , uj , up , vj , xnorm , xnrme integer :: i , imax , j , jp1 , k , key , kranke , last , lchk , link , m , & mapke1 , mdeqc , mend , mep1 , n1 , n2 , next , nlink , nopt , np1 , & ntimes logical :: cov , done character ( len = 8 ) :: xern1 , xern2 , xern3 , xern4 ! Set the nominal tolerance used in the code for the equality ! constraint equations. tau = sqrt ( drelpr ) ! Check that enough storage was allocated in WS(*) and IP(*). mode = 4 if ( min ( n , me , ma , mg ) < 0 ) then write ( xern1 , '(I8)' ) n write ( xern2 , '(I8)' ) me write ( xern3 , '(I8)' ) ma write ( xern4 , '(I8)' ) mg write ( * , * ) 'ALL OF THE VARIABLES N, ME,' // & ' MA, MG MUST BE >= 0. ENTERED ROUTINE WITH: ' // & 'N = ' // trim ( adjustl ( xern1 )) // & ', ME = ' // trim ( adjustl ( xern2 )) // & ', MA = ' // trim ( adjustl ( xern3 )) // & ', MG = ' // trim ( adjustl ( xern4 )) return endif if ( ip ( 1 ) > 0 ) then lchk = 2 * ( me + n ) + max ( ma + mg , n ) + ( mg + 2 ) * ( n + 7 ) if ( ip ( 1 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WS(*), NEED LW = ' // xern1 return endif endif if ( ip ( 2 ) > 0 ) then lchk = mg + 2 * n + 2 if ( ip ( 2 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IP(*), NEED LIP = ' // xern1 return endif endif ! Compute number of possible right multiplying Householder ! transformations. m = me + ma + mg if ( n <= 0 . or . m <= 0 ) then mode = 0 rnorme = 0 rnorml = 0 return endif if ( mdw < m ) then write ( * , * ) 'MDW < ME+MA+MG IS AN ERROR' return endif np1 = n + 1 kranke = min ( me , n ) n1 = 2 * kranke + 1 n2 = n1 + n ! Set nominal values. ! ! The nominal column scaling used in the code is ! the identity scaling. call dcopy ( n , [ 1.0_wp ], 0 , ws ( n1 ), 1 ) ! No covariance matrix is nominally computed. cov = . false . ! Process option vector. ! Define bound for number of options to change. nopt = 1000 ntimes = 0 ! Define bound for positive values of LINK. nlink = 100000 last = 1 link = prgopt ( 1 ) if ( link == 0 . or . link > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 1 ) then cov = prgopt ( last + 2 ) /= 0.0_wp elseif ( key == 2 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t ws ( j + n1 - 1 ) = t end do elseif ( key == 3 ) then call dcopy ( n , prgopt ( last + 2 ), 1 , ws ( n1 ), 1 ) elseif ( key == 4 ) then tau = max ( drelpr , prgopt ( last + 2 )) endif next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , ws ( n1 + j - 1 ), w ( 1 , j ), 1 ) end do if ( cov . and . mdw < n ) then write ( * , * ) 'MDW < N WHEN COV MATRIX NEEDED, IS AN ERROR' return endif ! Problem definition and option vector OK. mode = 0 ! Compute norm of equality constraint matrix and right side. enorm = 0.0_wp do j = 1 , n enorm = max ( enorm , dasum ( me , w ( 1 , j ), 1 )) end do fnorm = dasum ( me , w ( 1 , np1 ), 1 ) snmax = 0.0_wp rnmax = 0.0_wp do i = 1 , kranke ! Compute maximum ratio of vector lengths. Partition is at ! column I. do k = i , me sn = ddot ( n - i + 1 , w ( k , i ), mdw , w ( k , i ), mdw ) rn = ddot ( i - 1 , w ( k , 1 ), mdw , w ( k , 1 ), mdw ) if ( rn == 0.0_wp . and . sn > snmax ) then snmax = sn imax = k elseif ( k == i . or . sn * rnmax > rn * snmax ) then snmax = sn rnmax = rn imax = k endif end do ! Interchange rows if necessary. if ( i /= imax ) call dswap ( np1 , w ( i , 1 ), mdw , w ( imax , 1 ), mdw ) if ( snmax > rnmax * tau ** 2 ) then ! Eliminate elements I+1,...,N in row I. call dh12 ( 1 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), w ( i + 1 , 1 ), mdw , 1 , m - i ) else kranke = i - 1 exit endif end do ! Save diagonal terms of lower trapezoidal matrix. call dcopy ( kranke , w , mdw + 1 , ws ( kranke + 1 ), 1 ) ! Use Householder transformation from left to achieve ! KRANKE by KRANKE upper triangular form. if ( kranke < me ) then do k = kranke , 1 , - 1 ! Apply transformation to matrix cols. 1,...,K-1. call dh12 ( 1 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w , 1 , mdw , k - 1 ) ! Apply to rt side vector. call dh12 ( 2 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w ( 1 , np1 ), 1 , 1 , 1 ) end do endif ! Solve for variables 1,...,KRANKE in new coordinates. call dcopy ( kranke , w ( 1 , np1 ), 1 , x , 1 ) do i = 1 , kranke x ( i ) = ( x ( i ) - ddot ( i - 1 , w ( i , 1 ), mdw , x , 1 )) / w ( i , i ) end do ! Compute residuals for reduced problem. mep1 = me + 1 rnorml = 0.0_wp do i = mep1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( kranke , w ( i , 1 ), mdw , x , 1 ) sn = ddot ( kranke , w ( i , 1 ), mdw , w ( i , 1 ), mdw ) rn = ddot ( n - kranke , w ( i , kranke + 1 ), mdw , w ( i , kranke + 1 ), mdw ) if ( rn <= sn * tau ** 2 . and . kranke < n ) & call dcopy ( n - kranke , [ 0.0_wp ], 0 , w ( i , kranke + 1 ), mdw ) end do ! Compute equality constraint equations residual length. rnorme = dnrm2 ( me - kranke , w ( kranke + 1 , np1 ), 1 ) ! Move reduced problem data upward if KRANKE 0 ) then mdeqc = 0 xnrme = dasum ( kranke , w ( 1 , np1 ), 1 ) if ( rnorme > tau * ( enorm * xnrme + fnorm )) mdeqc = 1 mode = mode + mdeqc ! Check if solution to equality constraints satisfies inequality ! constraints when there are no degrees of freedom left. if ( kranke == n . and . mg > 0 ) then xnorm = dasum ( n , x , 1 ) mapke1 = ma + kranke + 1 mend = ma + kranke + mg do i = mapke1 , mend size = dasum ( n , w ( i , 1 ), mdw ) * xnorm + abs ( w ( i , np1 )) if ( w ( i , np1 ) > tau * size ) then mode = mode + 2 done = . true . exit endif end do endif endif if (. not . done ) then ! Replace diagonal terms of lower trapezoidal matrix. if ( kranke > 0 ) then call dcopy ( kranke , ws ( kranke + 1 ), 1 , w , mdw + 1 ) ! Reapply transformation to put solution in original coordinates. do i = kranke , 1 , - 1 call dh12 ( 2 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), x , 1 , 1 , 1 ) end do ! Compute covariance matrix of equality constrained problem. if ( cov ) then do j = min ( kranke , n - 1 ), 1 , - 1 rb = ws ( j ) * w ( j , j ) if ( rb /= 0.0_wp ) rb = 1.0_wp / rb jp1 = j + 1 do i = jp1 , n w ( i , j ) = rb * ddot ( n - j , w ( i , jp1 ), mdw , w ( j , jp1 ), mdw ) end do gam = 0.5_wp * rb * ddot ( n - j , w ( jp1 , j ), 1 , w ( j , jp1 ), mdw ) call daxpy ( n - j , gam , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) do i = jp1 , n do k = i , n w ( i , k ) = w ( i , k ) + w ( j , i ) * w ( k , j ) + w ( i , j ) * w ( j , k ) w ( k , i ) = w ( i , k ) end do end do uj = ws ( j ) vj = gam * uj w ( j , j ) = uj * vj + uj * vj do i = jp1 , n w ( j , i ) = uj * w ( i , j ) + vj * w ( j , i ) end do call dcopy ( n - j , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) end do endif endif ! Apply the scaling to the covariance matrix. if ( cov ) then do i = 1 , n call dscal ( n , ws ( i + n1 - 1 ), w ( i , 1 ), mdw ) call dscal ( n , ws ( i + n1 - 1 ), w ( 1 , i ), 1 ) end do endif end if ! Rescale solution vector. if ( mode <= 1 ) then do j = 1 , n x ( j ) = x ( j ) * ws ( n1 + j - 1 ) end do endif ip ( 1 ) = kranke ip ( 3 ) = ip ( 3 ) + 2 * kranke + n end subroutine dlsei !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DLSEI]]. The documentation for ! [[DLSEI]] has complete usage instructions. ! ! Solve: !``` ! AX = B, A MA by N (least squares equations) !``` ! ! subject to: !``` ! GX>=H, G MG by N (inequality constraints) !``` ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 900604 DP version created from SP version. (RWC) ! * 920422 Changed CALL to DHFTI to include variable MA. (WRB) subroutine dlsi ( w , mdw , ma , mg , n , prgopt , x , rnorm , mode , ws , ip ) integer , intent ( in ) :: mdw !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: ma !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: mg !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: n !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. real ( wp ) :: w ( mdw , * ) !! `W(*,*)` contains: !! !!``` !! (A B) !! (G H) !!``` !! !! in rows `1,...,MA+MG`, !! cols `1,...,N+1`. real ( wp ), intent ( in ) :: prgopt ( * ) !! Program option vector. real ( wp ), intent ( out ) :: x ( * ) !! Solution vector(unless MODE=2) real ( wp ), intent ( out ) :: rnorm !! length of AX-B. integer , intent ( out ) :: mode !! * `=0` Inequality constraints are compatible. !! * `=2` Inequality constraints contradictory. real ( wp ) :: ws ( * ) !! Working storage of dimension `K+N+(MG+2)*(N+7)`, !! where `K=MAX(MA+MG,N)`. integer :: ip ( * ) !! `IP(MG+2*N+1)` Integer working storage real ( wp ) :: anorm , fac , gam , rb , tau , tol , xnorm integer :: i , j , k , key , krank , krm1 , krp1 , l , last , link , m , map1 , & mdlpdp , minman , n1 , n2 , n3 , next , np1 logical :: cov , sclcov real ( wp ) :: rnorm_ ( 1 ) !! JW added for call to [[dhfti]] ! Set the nominal tolerance used in the code. tol = sqrt ( drelpr ) mode = 0 rnorm = 0.0_wp m = ma + mg np1 = n + 1 krank = 0 main : block if ( n <= 0 . or . m <= 0 ) exit main ! To process option vector. cov = . false . sclcov = . true . last = 1 link = prgopt ( 1 ) do if ( link <= 1 ) exit key = prgopt ( last + 1 ) if ( key == 1 ) cov = prgopt ( last + 2 ) /= 0.0_wp if ( key == 10 ) sclcov = prgopt ( last + 2 ) == 0.0_wp if ( key == 5 ) tol = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) last = link link = next end do ! Compute matrix norm of least squares equations. anorm = 0.0_wp do j = 1 , n anorm = max ( anorm , dasum ( ma , w ( 1 , j ), 1 )) end do ! Set tolerance for DHFTI( ) rank test. tau = tol * anorm ! Compute Householder orthogonal decomposition of matrix. call dcopy ( n , [ 0.0_wp ], 0 , ws , 1 ) call dcopy ( ma , w ( 1 , np1 ), 1 , ws , 1 ) k = max ( m , n ) minman = min ( ma , n ) n1 = k + 1 n2 = n1 + n rnorm_ ( 1 ) = rnorm ! JW call dhfti ( w , mdw , ma , n , ws , ma , 1 , tau , krank , rnorm_ , ws ( n2 ), & ws ( n1 ), ip ) rnorm = rnorm_ ( 1 ) ! JW fac = 1.0_wp gam = ma - krank if ( krank < ma . and . sclcov ) fac = rnorm ** 2 / gam ! Reduce to DLPDP and solve. map1 = ma + 1 ! Compute inequality rt-hand side for DLPDP. if ( ma < m ) then if ( minman > 0 ) then do i = map1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( n , w ( i , 1 ), mdw , ws , 1 ) end do ! Apply permutations to col. of inequality constraint matrix. do i = 1 , minman call dswap ( mg , w ( map1 , i ), 1 , w ( map1 , ip ( i )), 1 ) end do ! Apply Householder transformations to constraint matrix. if ( krank > 0 . and . krank < n ) then do i = krank , 1 , - 1 call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & w ( map1 , 1 ), mdw , 1 , mg ) end do endif ! Compute permuted inequality constraint matrix times r-inv. do i = map1 , m do j = 1 , krank w ( i , j ) = ( w ( i , j ) - ddot ( j - 1 , w ( 1 , j ), 1 , w ( i , 1 ), mdw )) / w ( j , j ) end do end do endif ! Solve the reduced problem with DLPDP algorithm, ! the least projected distance problem. call dlpdp ( w ( map1 , 1 ), mdw , mg , krank , n - krank , prgopt , x , & xnorm , mdlpdp , ws ( n2 ), ip ( n + 1 )) ! Compute solution in original coordinates. if ( mdlpdp == 1 ) then do i = krank , 1 , - 1 x ( i ) = ( x ( i ) - ddot ( krank - i , w ( i , i + 1 ), mdw , x ( i + 1 ), 1 )) / w ( i , i ) end do ! Apply Householder transformation to solution vector. if ( krank < n ) then do i = 1 , krank call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & x , 1 , 1 , 1 ) end do endif ! Repermute variables to their input order. if ( minman > 0 ) then do i = minman , 1 , - 1 call dswap ( 1 , x ( i ), 1 , x ( ip ( i )), 1 ) end do ! Variables are now in original coordinates. ! Add solution of unconstrained problem. do i = 1 , n x ( i ) = x ( i ) + ws ( i ) end do ! Compute the residual vector norm. rnorm = sqrt ( rnorm ** 2 + xnorm ** 2 ) endif else mode = 2 endif else call dcopy ( n , ws , 1 , x , 1 ) endif ! Compute covariance matrix based on the orthogonal decomposition ! from DHFTI( ). if (. not . cov . or . krank <= 0 ) exit main krm1 = krank - 1 krp1 = krank + 1 ! Copy diagonal terms to working array. call dcopy ( krank , w , mdw + 1 , ws ( n2 ), 1 ) ! Reciprocate diagonal terms. do j = 1 , krank w ( j , j ) = 1.0_wp / w ( j , j ) end do ! Invert the upper triangular QR factor on itself. if ( krank > 1 ) then do i = 1 , krm1 do j = i + 1 , krank w ( i , j ) = - ddot ( j - i , w ( i , i ), mdw , w ( i , j ), 1 ) * w ( j , j ) end do end do endif ! Compute the inverted factor times its transpose. do i = 1 , krank do j = i , krank w ( i , j ) = ddot ( krank + 1 - j , w ( i , j ), mdw , w ( j , j ), mdw ) end do end do ! Zero out lower trapezoidal part. ! Copy upper triangular to lower triangular part. if ( krank < n ) then do j = 1 , krank call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do do i = krp1 , n call dcopy ( i , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Apply right side transformations to lower triangle. n3 = n2 + krp1 do i = 1 , krank l = n1 + i k = n2 + i rb = ws ( l - 1 ) * ws ( k - 1 ) ! If RB>=0.0_wp, transformation can be regarded as zero. if ( rb < 0.0_wp ) then rb = 1.0_wp / rb ! Store unscaled rank one Householder update in work array. call dcopy ( n , [ 0.0_wp ], 0 , ws ( n3 ), 1 ) l = n1 + i k = n3 + i ws ( k - 1 ) = ws ( l - 1 ) do j = krp1 , n ws ( n3 + j - 1 ) = w ( i , j ) end do do j = 1 , n ws ( j ) = rb * ( ddot ( j - i , w ( j , i ), mdw , ws ( n3 + i - 1 ), 1 ) + & ddot ( n - j + 1 , w ( j , j ), 1 , ws ( n3 + j - 1 ), 1 )) end do l = n3 + i gam = 0.5_wp * rb * ddot ( n - i + 1 , ws ( l - 1 ), 1 , ws ( i ), 1 ) call daxpy ( n - i + 1 , gam , ws ( l - 1 ), 1 , ws ( i ), 1 ) do j = i , n do l = 1 , i - 1 w ( j , l ) = w ( j , l ) + ws ( n3 + j - 1 ) * ws ( l ) end do do l = i , j w ( j , l ) = w ( j , l ) + ws ( j ) * ws ( n3 + l - 1 ) + ws ( l ) * ws ( n3 + j - 1 ) end do end do endif end do ! Copy lower triangle to upper triangle to symmetrize the ! covariance matrix. do i = 1 , n call dcopy ( i , w ( i , 1 ), mdw , w ( 1 , i ), 1 ) end do endif ! Repermute rows and columns. do i = minman , 1 , - 1 k = ip ( i ) if ( i /= k ) then call dswap ( 1 , w ( i , i ), 1 , w ( k , k ), 1 ) call dswap ( i - 1 , w ( 1 , i ), 1 , w ( 1 , k ), 1 ) call dswap ( k - i - 1 , w ( i , i + 1 ), mdw , w ( i + 1 , k ), 1 ) call dswap ( n - k , w ( i , k + 1 ), mdw , w ( k , k + 1 ), mdw ) endif end do ! Put in normalized residual sum of squares scale factor ! and symmetrize the resulting covariance matrix. do j = 1 , n call dscal ( j , fac , w ( 1 , j ), 1 ) call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do end block main ip ( 1 ) = krank ip ( 2 ) = n + max ( m , n ) + ( mg + 2 ) * ( n + 7 ) end subroutine dlsi !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DWNNLS]]. ! The documentation for [[DWNNLS]] has complete usage instructions. ! ! Note: The `M` by `(N+1)` matrix `W( , )` contains the rt. hand side ! `B` as the `(N+1)`st col. ! ! Triangularize `L1` by `L1` subsystem, where `L1=MIN(M,L)`, with ! col interchanges. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and revised. (WRB & RWC) ! * 890620 Revised to make WNLT1, WNLT2, and WNLT3 subroutines. (RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 900604 DP version created from SP version. . (RWC) subroutine dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , & rnorm , idope , dope , done ) integer :: idope ( * ), ipivot ( * ), itype ( * ), l , m , mdw , n real ( wp ) :: dope ( * ), h ( * ), rnorm , scale ( * ), w ( mdw , * ) logical :: done real ( wp ) :: alsq , amax , eanorm , factor , hbar , rn , sparam ( 5 ), & t , tau integer :: i , i1 , imax , ir , j , j1 , jj , jp , krank , l1 , lb , lend , me , & mend , niv , nsoln logical :: indep , recalc me = idope ( 1 ) nsoln = idope ( 2 ) l1 = idope ( 3 ) alsq = dope ( 1 ) eanorm = dope ( 2 ) tau = dope ( 3 ) lb = min ( m - 1 , l ) recalc = . true . rnorm = 0.0_wp krank = 0 ! We set FACTOR=1.0 so that the heavy weight ALAMDA will be ! included in the test for column independence. factor = 1.0_wp lend = l main : block do i = 1 , lb ! Set IR to point to the I-th row. ir = i mend = m call dwnlt1 ( i , lend , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) do ! Perform column interchange. ! Test independence of incoming column. if ( dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then ! Eliminate I-th column below diagonal using modified Givens ! transformations applied to (A B). ! ! When operating near the ME line, use the largest element ! above it as the pivot. do j = m , i + 1 , - 1 jp = j - 1 if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , i ) ** 2 do jp = j - 1 , i , - 1 t = scale ( jp ) * w ( jp , i ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( jp , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do exit else if ( lend > i ) then ! Column I is dependent. Swap with column LEND. ! Perform column interchange, ! and find column in remaining set with largest SS. call dwnlt3 ( i , lend , m , mdw , ipivot , h , w ) lend = lend - 1 imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) else krank = i - 1 exit main endif end do end do krank = l1 end block main if ( krank < me ) then factor = alsq do i = krank + 1 , me call dcopy ( l , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Determine the rank of the remaining equality constraint ! equations by eliminating within the block of constrained ! variables. Remove any redundant constraints. recalc = . true . lb = min ( l + me - krank , n ) do i = l + 1 , lb ir = krank + i - l lend = n mend = me call dwnlt1 ( i , lend , me , ir , mdw , recalc , imax , hbar , h , & scale , w ) ! Update col ss and find pivot col call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange ! Eliminate elements in the I-th col. do j = me , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do ! I=column being eliminated. ! Test independence of incoming column. ! Remove any redundant or dependent equality constraints. if (. not . dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then jj = ir do ir = jj , me call dcopy ( n , [ 0.0_wp ], 0 , w ( ir , 1 ), mdw ) rnorm = rnorm + ( scale ( ir ) * w ( ir , n + 1 ) / alsq ) * w ( ir , n + 1 ) w ( ir , n + 1 ) = 0.0_wp scale ( ir ) = 1.0_wp ! Reclassify the zeroed row as a least squares equation. itype ( ir ) = 1 end do ! Reduce ME to reflect any discovered dependent equality ! constraints. me = jj - 1 exit endif end do endif ! Try to determine the variables KRANK+1 through L1 from the ! least squares equations. Continue the triangularization with ! pivot element W(ME+1,I). if ( krank < l1 ) then recalc = . true . ! Set FACTOR=ALSQ to remove effect of heavy weight from ! test for column independence. factor = alsq do i = krank + 1 , l1 ! Set IR to point to the ME+1-st row. ir = me + 1 lend = l mend = m call dwnlt1 ( i , l , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange. ! Eliminate I-th column below the IR-th element. do j = m , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , sparam ) endif end do ! Test if new pivot element is near zero. ! If so, the column is dependent. ! Then check row norm test to be classified as independent. t = scale ( ir ) * w ( ir , i ) ** 2 indep = t > ( tau * eanorm ) ** 2 if ( indep ) then rn = 0.0_wp do i1 = ir , m do j1 = i + 1 , n rn = max ( rn , scale ( i1 ) * w ( i1 , j1 ) ** 2 ) end do end do indep = t > rn * tau ** 2 endif ! If independent, swap the IR-th and KRANK+1-th rows to ! maintain the triangular form. Update the rank indicator ! KRANK and the equality constraint pointer ME. if (. not . indep ) exit call dswap ( n + 1 , w ( krank + 1 , 1 ), mdw , w ( ir , 1 ), mdw ) call dswap ( 1 , scale ( krank + 1 ), 1 , scale ( ir ), 1 ) ! Reclassify the least square equation as an equality ! constraint and rescale it. itype ( ir ) = 0 t = sqrt ( scale ( krank + 1 )) call dscal ( n + 1 , t , w ( krank + 1 , 1 ), mdw ) scale ( krank + 1 ) = alsq me = me + 1 krank = krank + 1 end do endif ! If pseudorank is less than L, apply Householder transformation. ! from right. if ( krank < l ) then do j = krank , 1 , - 1 call dh12 ( 1 , j , krank + 1 , l , w ( j , 1 ), mdw , h ( j ), w , mdw , 1 , & j - 1 ) end do endif niv = krank + nsoln - l if ( l == n ) done = . true . ! End of initial triangularization. idope ( 1 ) = me idope ( 2 ) = krank idope ( 3 ) = niv end subroutine dwnlit !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DWNNLS]]. ! The documentation for [[DWNNLS]] has complete usage instructions. ! ! In addition to the parameters discussed in the prologue to ! subroutine [[DWNNLS]], the following work arrays are used in ! subroutine [[DWNLSM]] (they are passed through the calling ! sequence from [[DWNNLS]] for purposes of variable dimensioning). ! Their contents will in general be of no interest to the user. ! ! IPIVOT(*) ! An array of length N. Upon completion it contains the ! pivoting information for the cols of W(*,*). ! ! ITYPE(*) ! An array of length M which is used to keep track ! of the classification of the equations. ITYPE(I)=0 ! denotes equation I as an equality constraint. ! ITYPE(I)=1 denotes equation I as a least squares ! equation. ! ! WD(*) ! An array of length N. Upon completion it contains the ! dual solution vector. ! ! H(*) ! An array of length N. Upon completion it contains the ! pivot scalars of the Householder transformations performed ! in the case KRANK nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'IN DWNNLS, THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 6 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t d ( j ) = t end do endif if ( key == 7 ) call dcopy ( n , prgopt ( last + 2 ), 1 , d , 1 ) if ( key == 8 ) tau = max ( drelpr , prgopt ( last + 2 )) if ( key == 9 ) blowup = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , d ( j ), w ( 1 , j ), 1 ) end do ! Process option vector done = . false . iter = 0 itmax = 3 * ( n - l ) mode = 0 nsoln = l l1 = min ( m , l ) ! Compute scale factor to apply to equality constraint equations. do j = 1 , n wd ( j ) = dasum ( m , w ( 1 , j ), 1 ) end do imax = idamax ( n , wd , 1 ) eanorm = wd ( imax ) bnorm = dasum ( m , w ( 1 , n + 1 ), 1 ) alamda = eanorm / ( drelpr * fac ) ! On machines, such as the VAXes using D floating, with a very ! limited exponent range for double precision values, the previously ! computed value of ALAMDA may cause an overflow condition. ! Therefore, this code further limits the value of ALAMDA. alamda = min ( alamda , sqrt ( huge ( 1.0_wp ))) ! Define scaling diagonal matrix for modified Givens usage and ! classify equation types. alsq = alamda ** 2 do i = 1 , m ! When equation I is heavily weighted ITYPE(I)=0, ! else ITYPE(I)=1. if ( i <= me ) then t = alsq itemp = 0 else t = 1.0_wp itemp = 1 endif scale ( i ) = t itype ( i ) = itemp end do ! Set the solution vector X(*) to zero and the column interchange ! matrix to the identity. call dcopy ( n , [ 0.0_wp ], 0 , x , 1 ) do i = 1 , n ipivot ( i ) = i end do ! Perform initial triangularization in the submatrix ! corresponding to the unconstrained variables. ! Set first L components of dual vector to zero because ! these correspond to the unconstrained variables. call dcopy ( l , [ 0.0_wp ], 0 , wd , 1 ) ! The arrays IDOPE(*) and DOPE(*) are used to pass ! information to DWNLIT(). This was done to avoid ! a long calling sequence or the use of COMMON. idope ( 1 ) = me idope ( 2 ) = nsoln idope ( 3 ) = l1 dope ( 1 ) = alsq dope ( 2 ) = eanorm dope ( 3 ) = tau call dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , rnorm , & idope , dope , done ) me = idope ( 1 ) krank = idope ( 2 ) niv = idope ( 3 ) main : do ! Perform WNNLS algorithm using the following steps. ! ! Until(DONE) ! compute search direction and feasible point ! when (HITCON) add constraints ! else perform multiplier test and drop a constraint ! fin ! Compute-Final-Solution ! ! To compute search direction and feasible point, ! solve the triangular system of currently non-active ! variables and store the solution in Z(*). ! ! To solve system ! Copy right hand side into TEMP vector to use overwriting method. if ( done ) exit main isol = l + 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Increment iteration counter and check against maximum number ! of iterations. iter = iter + 1 if ( iter > itmax ) then mode = 1 done = . true . endif ! Check to see if any constraints have become active. ! If so, calculate an interpolation factor so that all ! active constraints are removed from the basis. alpha = 2.0_wp hitcon = . false . do j = l + 1 , nsoln zz = z ( j ) if ( zz <= 0.0_wp ) then t = x ( j ) / ( x ( j ) - zz ) if ( t < alpha ) then alpha = t jcon = j endif hitcon = . true . endif end do ! Compute search direction and feasible point if ( hitcon ) then ! To add constraints, use computed ALPHA to interpolate between ! last feasible solution X(*) and current unconstrained (and ! infeasible) solution Z(*). do j = l + 1 , nsoln x ( j ) = x ( j ) + alpha * ( z ( j ) - x ( j )) end do feasbl = . false . do ! Remove column JCON and shift columns JCON+1 through N to the ! left. Swap column JCON into the N th position. This achieves ! upper Hessenberg form for the nonactive constraints and ! leaves an upper Hessenberg matrix to retriangularize. do i = 1 , m t = w ( i , jcon ) call dcopy ( n - jcon , w ( i , jcon + 1 ), mdw , w ( i , jcon ), mdw ) w ( i , n ) = t end do ! Update permuted index vector to reflect this shift and swap. itemp = ipivot ( jcon ) do i = jcon , n - 1 ipivot ( i ) = ipivot ( i + 1 ) end do ipivot ( n ) = itemp ! Similarly permute X(*) vector. call dcopy ( n - jcon , x ( jcon + 1 ), 1 , x ( jcon ), 1 ) x ( n ) = 0.0_wp nsoln = nsoln - 1 niv = niv - 1 ! Retriangularize upper Hessenberg matrix after adding ! constraints. i = krank + jcon - l do j = jcon , nsoln if ( itype ( i ) == 0 . and . itype ( i + 1 ) == 0 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 1 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 0 ) then call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp ! Swapped row was formerly a pivot element, so it will ! be large enough to perform elimination. ! Zero IP1 to I in column J. if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 0 . and . itype ( i + 1 ) == 1 ) then if ( scale ( i ) * w ( i , j ) ** 2 / alsq > ( tau * eanorm ) ** 2 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), & w ( i + 1 , j ), sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp w ( i + 1 , j ) = 0.0_wp endif endif i = i + 1 end do ! See if the remaining coefficients in the solution set are ! feasible. They should be because of the way ALPHA was ! determined. If any are infeasible, it is due to roundoff ! error. Any that are non-positive will be set to zero and ! removed from the solution set. do jcon = l + 1 , nsoln if ( x ( jcon ) <= 0.0_wp ) then exit else if ( jcon == nsoln ) feasbl = . true . end if end do if ( feasbl ) exit end do else ! To perform multiplier test and drop a constraint. call dcopy ( nsoln , z , 1 , x , 1 ) if ( nsoln < n ) call dcopy ( n - nsoln , [ 0.0_wp ], 0 , x ( nsoln + 1 ), 1 ) ! Reclassify least squares equations as equalities as necessary. i = niv + 1 do if ( i > me ) exit if ( itype ( i ) == 0 ) then i = i + 1 else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( me , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( me ), 1 ) itemp = itype ( i ) itype ( i ) = itype ( me ) itype ( me ) = itemp me = me - 1 endif end do ! Form inner product vector WD(*) of dual coefficients. do j = nsoln + 1 , n sm = 0.0_wp do i = nsoln + 1 , m sm = sm + scale ( i ) * w ( i , j ) * w ( i , n + 1 ) end do wd ( j ) = sm end do do ! Find J such that WD(J)=WMAX is maximum. This determines ! that the incoming column J will reduce the residual vector ! and be positive. wmax = 0.0_wp iwmax = nsoln + 1 do j = nsoln + 1 , n if ( wd ( j ) > wmax ) then wmax = wd ( j ) iwmax = j endif end do if ( wmax <= 0.0_wp ) exit main ! Set dual coefficients to zero for incoming column. wd ( iwmax ) = 0.0_wp ! WMAX > 0.0_wp, so okay to move column IWMAX to solution set. ! Perform transformation to retriangularize, and test for near ! linear dependence. ! ! Swap column IWMAX into NSOLN-th position to maintain upper ! Hessenberg form of adjacent columns, and add new column to ! triangular decomposition. nsoln = nsoln + 1 niv = niv + 1 if ( nsoln /= iwmax ) then call dswap ( m , w ( 1 , nsoln ), 1 , w ( 1 , iwmax ), 1 ) wd ( iwmax ) = wd ( nsoln ) wd ( nsoln ) = 0.0_wp itemp = ipivot ( nsoln ) ipivot ( nsoln ) = ipivot ( iwmax ) ipivot ( iwmax ) = itemp endif ! Reduce column NSOLN so that the matrix of nonactive constraints ! variables is triangular. do j = m , niv + 1 , - 1 jp = j - 1 ! When operating near the ME line, test to see if the pivot ! element is near zero. If so, use the largest element above ! it as the pivot. This is to maintain the sharp interface ! between weighted and non-weighted rows in all cases. if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , nsoln ) ** 2 do jp = j - 1 , niv , - 1 t = scale ( jp ) * w ( jp , nsoln ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , nsoln ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , nsoln ), w ( j , nsoln ), sparam ) w ( j , nsoln ) = 0.0_wp call drotm ( n + 1 - nsoln , w ( jp , nsoln + 1 ), mdw , w ( j , nsoln + 1 ), mdw , sparam ) endif end do ! Solve for Z(NSOLN)=proposed new value for X(NSOLN). Test if ! this is nonpositive or too large. If this was true or if the ! pivot term was zero, reject the column as dependent. if ( w ( niv , nsoln ) /= 0.0_wp ) then isol = niv z2 = w ( isol , n + 1 ) / w ( isol , nsoln ) z ( nsoln ) = z2 pos = z2 > 0.0_wp if ( z2 * eanorm >= bnorm . and . pos ) then pos = . not . ( blowup * z2 * eanorm >= bnorm ) endif elseif ( niv <= me . and . w ( me + 1 , nsoln ) /= 0.0_wp ) then ! Try to add row ME+1 as an additional equality constraint. ! Check size of proposed new solution component. ! Reject it if it is too large. isol = me + 1 if ( pos ) then ! Swap rows ME+1 and NIV, and scale factors for these rows. call dswap ( n + 1 , w ( me + 1 , 1 ), mdw , w ( niv , 1 ), mdw ) call dswap ( 1 , scale ( me + 1 ), 1 , scale ( niv ), 1 ) itemp = itype ( me + 1 ) itype ( me + 1 ) = itype ( niv ) itype ( niv ) = itemp me = me + 1 endif else pos = . false . endif if (. not . pos ) then nsoln = nsoln - 1 niv = niv - 1 endif if ( pos . or . done ) exit end do endif end do main ! Else perform multiplier test and drop a constraint. To compute ! final solution. Solve system, store results in X(*). ! ! Copy right hand side into TEMP vector to use overwriting method. isol = 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Solve system. call dcopy ( nsoln , z , 1 , x , 1 ) ! Apply Householder transformations to X(*) if KRANK ! To update the column Sum Of Squares and find the pivot column. ! The column Sum of Squares Vector will be updated at each step. ! When numerically necessary, these values will be recomputed. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890620 Code extracted from WNLIT and made a subroutine. (RWC)) ! * 900604 DP version created from SP version. (RWC) subroutine dwnlt1 ( i , lend , mend , ir , mdw , recalc , imax , hbar , h , & scale , w ) integer :: i , imax , ir , lend , mdw , mend real ( wp ) :: h ( * ), hbar , scale ( * ), w ( mdw , * ) logical :: recalc integer :: j , k if ( ir /= 1 . and . (. not . recalc )) then ! Update column SS=sum of squares. do j = i , lend h ( j ) = h ( j ) - scale ( ir - 1 ) * w ( ir - 1 , j ) ** 2 end do ! Test for numerical accuracy. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 recalc = ( hbar + 1.e-3 * h ( imax )) == hbar endif ! If required, recalculate column SS, using rows IR through MEND. if ( recalc ) then do j = i , lend h ( j ) = 0.0_wp do k = ir , mend h ( j ) = h ( j ) + scale ( k ) * w ( k , j ) ** 2 end do end do ! Find column with largest SS. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) endif end subroutine dwnlt1 !***************************************************************************************** !***************************************************************************************** !> ! To test independence of incoming column. ! ! Test the column IC to determine if it is linearly independent ! of the columns already in the basis. In the initial tri. step, ! we usually want the heavy weight ALAMDA to be included in the ! test for independence. In this case, the value of `FACTOR` will ! have been set to 1.0 before this procedure is invoked. ! In the potentially rank deficient problem, the value of FACTOR ! will have been set to `ALSQ=ALAMDA**2` to remove the effect of the ! heavy weight from the test for independence. ! ! Write new column as partitioned vector ! ! * `(A1)` number of components in solution so far `= NIV` ! * `(A2)` `M-NIV` components ! ! And compute ! ! * `SN` = inverse weighted length of `A1` ! * `RN` = inverse weighted length of `A2` ! ! Call the column independent when `RN > TAU*SN` ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890620 Code extracted from WNLIT and made a subroutine. (RWC)) ! * 900604 DP version created from SP version. (RWC) logical function dwnlt2 ( me , mend , ir , factor , tau , scale , wic ) real ( wp ) :: factor , scale ( * ), tau , wic ( * ) integer :: ir , me , mend real ( wp ) :: rn , sn , t integer :: j sn = 0.0_wp rn = 0.0_wp do j = 1 , mend t = scale ( j ) if ( j <= me ) t = t / factor t = t * wic ( j ) ** 2 if ( j < ir ) then sn = sn + t else rn = rn + t endif end do dwnlt2 = rn > sn * tau ** 2 end function dwnlt2 !***************************************************************************************** !***************************************************************************************** !> ! Perform column interchange. ! Exchange elements of permuted index vector and perform column ! interchanges. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890620 Code extracted from WNLIT and made a subroutine. (RWC)) ! * 900604 DP version created from SP version. (RWC) subroutine dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) integer , intent ( in ) :: i integer , intent ( in ) :: imax integer , intent ( inout ) :: ipivot ( * ) integer , intent ( in ) :: m integer , intent ( in ) :: mdw real ( wp ), intent ( inout ) :: h ( * ) real ( wp ), intent ( inout ) :: w ( mdw , * ) real ( wp ) :: t integer :: itemp if ( imax /= i ) then itemp = ipivot ( i ) ipivot ( i ) = ipivot ( imax ) ipivot ( imax ) = itemp call dswap ( m , w ( 1 , imax ), 1 , w ( 1 , i ), 1 ) t = h ( imax ) h ( imax ) = h ( i ) h ( i ) = t endif end subroutine dwnlt3 !***************************************************************************************** !***************************************************************************************** !> ! This subprogram solves a linearly constrained least squares ! problem. Suppose there are given matrices `E` and `A` of ! respective dimensions `ME` by `N` and `MA` by `N`, and vectors `F` ! and `B` of respective lengths `ME` and `MA`. This subroutine ! solves the problem ! ! * `EX = F`, (equations to be exactly satisfied) ! * `AX = B`, (equations to be approximately satisfied, in the least squares sense) ! ! subject to components `L+1,...,N` nonnegative ! ! Any values `ME>=0`, `MA>=0` and `0<= L <=N` are permitted. ! ! The problem is reposed as problem [[DWNNLS]] ! !``` ! (WT*E)X = (WT*F) ! ( A) ( B), (least squares) ! subject to components L+1,...,N nonnegative. !``` ! ! The subprogram chooses the heavy weight (or penalty parameter) `WT`. ! ! The parameters for [[DWNNLS]] are ! !``` ! INPUT.. All TYPE REAL variables are DOUBLE PRECISION ! ! W(*,*),MDW, The array W(*,*) is double subscripted with first ! ME,MA,N,L dimensioning parameter equal to MDW. For this ! discussion let us call M = ME + MA. Then MDW ! must satisfy MDW>=M. The condition MDWN is ! an error. ! ! PRGOPT(*) This double precision array is the option vector. ! If the user is satisfied with the nominal ! subprogram features set ! ! PRGOPT(1)=1 (or PRGOPT(1)=1.0) ! ! Otherwise PRGOPT(*) is a linked list consisting of ! groups of data of the following form ! ! LINK ! KEY ! DATA SET ! ! The parameters LINK and KEY are each one word. ! The DATA SET can be comprised of several words. ! The number of items depends on the value of KEY. ! The value of LINK points to the first ! entry of the next group of data within ! PRGOPT(*). The exception is when there are ! no more options to change. In that ! case LINK=1 and the values KEY and DATA SET ! are not referenced. The general layout of ! PRGOPT(*) is as follows. ! ! ...PRGOPT(1)=LINK1 (link to first entry of next group) ! . PRGOPT(2)=KEY1 (key to the option change) ! . PRGOPT(3)=DATA VALUE (data value for this change) ! . . ! . . ! . . ! ...PRGOPT(LINK1)=LINK2 (link to the first entry of ! . next group) ! . PRGOPT(LINK1+1)=KEY2 (key to the option change) ! . PRGOPT(LINK1+2)=DATA VALUE ! ... . ! . . ! . . ! ...PRGOPT(LINK)=1 (no more options to change) ! ! Values of LINK that are nonpositive are errors. ! A value of LINK>NLINK=100000 is also an error. ! This helps prevent using invalid but positive ! values of LINK that will probably extend ! beyond the program limits of PRGOPT(*). ! Unrecognized values of KEY are ignored. The ! order of the options is arbitrary and any number ! of options can be changed with the following ! restriction. To prevent cycling in the ! processing of the option array a count of the ! number of options changed is maintained. ! Whenever this count exceeds NOPT=1000 an error ! message is printed and the subprogram returns. ! ! OPTIONS.. ! ! KEY=6 ! Scale the nonzero columns of the ! entire data matrix ! (E) ! (A) ! to have length one. The DATA SET for ! this option is a single value. It must ! be nonzero if unit length column scaling is ! desired. ! ! KEY=7 ! Scale columns of the entire data matrix ! (E) ! (A) ! with a user-provided diagonal matrix. ! The DATA SET for this option consists ! of the N diagonal scaling factors, one for ! each matrix column. ! ! KEY=8 ! Change the rank determination tolerance from ! the nominal value of SQRT(SRELPR). This quantity ! can be no smaller than SRELPR, The arithmetic- ! storage precision. The quantity used ! here is internally restricted to be at ! least SRELPR. The DATA SET for this option ! is the new tolerance. ! ! KEY=9 ! Change the blow-up parameter from the ! nominal value of SQRT(SRELPR). The reciprocal of ! this parameter is used in rejecting solution ! components as too large when a variable is ! first brought into the active set. Too large ! means that the proposed component times the ! reciprocal of the parameter is not less than ! the ratio of the norms of the right-side ! vector and the data matrix. ! This parameter can be no smaller than SRELPR, ! the arithmetic-storage precision. ! ! For example, suppose we want to provide ! a diagonal matrix to scale the problem ! matrix and change the tolerance used for ! determining linear dependence of dropped col ! vectors. For these options the dimensions of ! PRGOPT(*) must be at least N+6. The FORTRAN ! statements defining these options would ! be as follows. ! ! PRGOPT(1)=N+3 (link to entry N+3 in PRGOPT(*)) ! PRGOPT(2)=7 (user-provided scaling key) ! ! CALL DCOPY(N,D,1,PRGOPT(3),1) (copy the N ! scaling factors from a user array called D(*) ! into PRGOPT(3)-PRGOPT(N+2)) ! ! PRGOPT(N+3)=N+6 (link to entry N+6 of PRGOPT(*)) ! PRGOPT(N+4)=8 (linear dependence tolerance key) ! PRGOPT(N+5)=... (new value of the tolerance) ! ! PRGOPT(N+6)=1 (no more options to change) ! ! ! IWORK(1), The amounts of working storage actually allocated ! IWORK(2) for the working arrays WORK(*) and IWORK(*), ! respectively. These quantities are compared with ! the actual amounts of storage needed for DWNNLS( ). ! Insufficient storage allocated for either WORK(*) ! or IWORK(*) is considered an error. This feature ! was included in DWNNLS( ) because miscalculating ! the storage formulas for WORK(*) and IWORK(*) ! might very well lead to subtle and hard-to-find ! execution errors. ! ! The length of WORK(*) must be at least ! ! LW = ME+MA+5*N ! This test will not be made if IWORK(1)<=0. ! ! The length of IWORK(*) must be at least ! ! LIW = ME+MA+N ! This test will not be made if IWORK(2)<=0. ! ! OUTPUT.. All TYPE REAL variables are DOUBLE PRECISION ! ! X(*) An array dimensioned at least N, which will ! contain the N components of the solution vector ! on output. ! ! RNORM The residual norm of the solution. The value of ! RNORM contains the residual vector length of the ! equality constraints and least squares equations. ! ! MODE The value of MODE indicates the success or failure ! of the subprogram. ! ! MODE = 0 Subprogram completed successfully. ! ! = 1 Max. number of iterations (equal to ! 3*(N-L)) exceeded. Nearly all problems ! should complete in fewer than this ! number of iterations. An approximate ! solution and its corresponding residual ! vector length are in X(*) and RNORM. ! ! = 2 Usage error occurred. The offending ! condition is noted with the error ! processing subprogram, XERMSG( ). ! ! User-designated ! Working arrays.. ! ! WORK(*) A double precision working array of length at least ! M + 5*N. ! ! IWORK(*) An integer-valued working array of length at least ! M+N. !``` ! !### References ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Report SAND77-0552, Sandia ! Laboratories, June 1978. ! * K. H. Haskell and R. J. Hanson, Selected algorithms for ! the linearly constrained least squares problem - a ! users guide, Report SAND78-1290, Sandia Laboratories, ! August 1979. ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Mathematical Programming ! 21 (1981), pp. 98-118. ! * R. J. Hanson and K. H. Haskell, Two algorithms for the ! linearly constrained least squares problem, ACM ! Transactions on Mathematical Software, September 1982. ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and revised. (WRB & RWC) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900510 Convert XERRWV calls to XERMSG calls, change Prologue ! comments to agree with WNNLS. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dwnnls ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , & iwork , work ) integer :: iwork ( * ), l , l1 , l2 , l3 , l4 , l5 , liw , lw , ma , mdw , me , & mode , n real ( wp ) :: prgopt ( * ), rnorm , w ( mdw , * ), work ( * ), x ( * ) character ( len = 8 ) :: xern1 mode = 0 if ( ma + me <= 0 . or . n <= 0 ) return if ( iwork ( 1 ) > 0 ) then lw = me + ma + 5 * n if ( iwork ( 1 ) < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WORK(*), NEED LW = ' // xern1 mode = 2 return endif endif if ( iwork ( 2 ) > 0 ) then liw = me + ma + n if ( iwork ( 2 ) < liw ) then write ( xern1 , '(I8)' ) liw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IWORK(*), NEED LIW = ' // xern1 mode = 2 return endif endif if ( mdw < me + ma ) then write ( * , * ) 'THE VALUE MDW n ) then write ( * , * ) 'L>=0 .AND. L<=N IS REQUIRED' mode = 2 return endif ! THE PURPOSE OF THIS SUBROUTINE IS TO BREAK UP THE ARRAYS ! WORK(*) AND IWORK(*) INTO SEPARATE WORK ARRAYS ! REQUIRED BY THE MAIN SUBROUTINE DWNLSM( ). l1 = n + 1 l2 = l1 + n l3 = l2 + me + ma l4 = l3 + n l5 = l4 + n call dwnlsm ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , iwork , & iwork ( l1 ), work ( 1 ), work ( l1 ), work ( l2 ), work ( l3 ), & work ( l4 ), work ( l5 )) end subroutine dwnnls !***************************************************************************************** !***************************************************************************************** !> ! [[dcv]] is a companion function subprogram for [[dfc]]. The ! documentation for [[dfc]] has complete usage instructions. ! ! [[dcv]] is used to evaluate the variance function of the curve ! obtained by the constrained B-spline fitting subprogram, [[dfc]]. ! The variance function defines the square of the probable error ! of the fitted curve at any point, XVAL. One can use the square ! root of this variance function to determine a probable error band ! around the fitted curve. ! ! [[dcv]] is used after a call to [[dfc]]. MODE, an input variable to ! [[dfc]], is used to indicate if the variance function is desired. ! In order to use [[dcv]], MODE must equal 2 or 4 on input to [[dfc]]. ! MODE is also used as an output flag from [[dfc]]. Check to make ! sure that MODE = 0 after calling [[dfc]], indicating a successful ! constrained curve fit. The array SDDATA, as input to [[dfc]], must ! also be defined with the standard deviation or uncertainty of the ! Y values to use [[dcv]]. ! ! To evaluate the variance function after calling [[dfc]] as stated ! above, use [[dcv]] as shown here ! ! `VAR = DCV(XVAL,NDATA,NCONST,NORD,NBKPT,BKPT,W)` ! ! The variance function is given by ! ! `VAR = (transpose of B(XVAL))*C*B(XVAL)/DBLE(MAX(NDATA-N,1))` ! ! where `N = NBKPT - NORD`. ! ! The vector B(XVAL) is the B-spline basis function values at ! X=XVAL. The covariance matrix, C, of the solution coefficients ! accounts only for the least squares equations and the explicitly ! stated equality constraints. This fact must be considered when ! interpreting the variance function from a data fitting problem ! that has inequality constraints on the fitted curve. ! ! All the variables in the calling sequence for [[dcv]] are used in ! [[dfc]] except the variable XVAL. Do not change the values of ! these variables between the call to [[dfc]] and the use of [[dcv]]. ! !### Reference ! * R. J. Hanson, Constrained least squares curve fitting ! to discrete data using B-splines, a users guide, ! Report SAND78-1291, Sandia Laboratories, December ! 1978. ! !### Revision history ! * 780801 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 890911 Removed unnecessary intrinsics. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 920501 Reformatted the REFERENCES section. (WRB) real ( wp ) function dcv ( xval , ndata , nconst , nord , nbkpt , bkpt , w ) real ( wp ), intent ( in ) :: xval !! The point where the variance is desired integer , intent ( in ) :: nbkpt !! The number of knots in the array BKPT(*). !! The value of NBKPT must satisfy NBKPT .GE. 2*NORD. integer , intent ( in ) :: nconst !! The number of conditions that constrained the B-spline in !! [[dfc]]. integer , intent ( in ) :: ndata !! The number of discrete (X,Y) pairs for which [[dfc]] !! calculated a piece-wise polynomial curve. integer , intent ( in ) :: nord !! The order of the B-spline used in [[dfc]]. !! The value of NORD must satisfy 1 < NORD < 20 . !! !! (The order of the spline is one more than the degree of !! the piece-wise polynomial defined on each interval. This !! is consistent with the B-spline package convention. For !! example, NORD=4 when we are using piece-wise cubics.) real ( wp ), intent ( in ) :: bkpt ( * ) !! The array of knots. Normally the problem !! data interval will be included between the limits !! BKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end !! knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT, !! are required by [[dfc]] to compute the functions used to !! fit the data. real ( wp ) :: w ( * ) !! Real work array as used in [[dfc]]. See [[dfc]] !! for the required length of W(*). The contents of W(*) !! must not be modified by the user if the variance function !! is desired. real ( wp ) :: v ( 40 ) integer :: i , ileft , ip , is , last , mdg , mdw , n integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap real ( wp ), parameter :: zero = 0.0_wp ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = zero dfspvn_deltap = zero mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst is = mdg * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + nord ** 2 last = nbkpt - nord + 1 ileft = nord do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= last - 1 ) exit ileft = ileft + 1 end do call dfspvn ( bkpt , nord , 1 , xval , ileft , v ( nord + 1 ), & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ileft = ileft - nord + 1 ip = mdw * ( ileft - 1 ) + ileft + is n = nbkpt - nord do i = 1 , nord v ( i ) = ddot ( nord , w ( ip ), 1 , v ( nord + 1 ), 1 ) ip = ip + mdw end do dcv = max ( ddot ( nord , v , 1 , v ( nord + 1 ), 1 ), zero ) ! scale the variance so it is an unbiased estimate. dcv = dcv / max ( ndata - n , 1 ) end function dcv !***************************************************************************************** !***************************************************************************************** end module bspline_defc_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_defc_module.f90.html"},{"title":"bspline_sub_module.f90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_sub_module.f90~~EfferentGraph sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_sub_module.f90~~AfferentGraph sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! !### Description ! ! Multidimensional (1D-6D) B-spline interpolation of data on a regular grid. ! Basic pure subroutine interface. ! !### Notes ! ! This module is based on the B-spline and spline routines from [1]. ! The original Fortran 77 routines were converted to free-form source. ! Some of them are relatively unchanged from the originals, but some have ! been extensively refactored. In addition, new routines for ! 1d, 4d, 5d, and 6d interpolation were also created (these are simply ! extensions of the same algorithm into higher dimensions). ! !### See also ! * An object-oriented interface can be found in [[bspline_oo_module]]. ! !### References ! ! 1. DBSPLIN and DTENSBS from the ! [NIST Core Math Library](http://www.nist.gov/itl/math/mcsd-software.cfm). ! Original code is public domain. ! 2. Carl de Boor, \"A Practical Guide to Splines\", ! Springer-Verlag, New York, 1978. ! 3. Carl de Boor, [Efficient Computer Manipulation of Tensor ! Products](http://dl.acm.org/citation.cfm?id=355831), ! ACM Transactions on Mathematical Software, ! Vol. 5 (1979), p. 173-182. ! 4. D.E. Amos, \"Computation with Splines and B-Splines\", ! SAND78-1968, Sandia Laboratories, March, 1979. ! 5. Carl de Boor, ! [Package for calculating with B-splines](http://epubs.siam.org/doi/abs/10.1137/0714026), ! SIAM Journal on Numerical Analysis 14, 3 (June 1977), p. 441-472. ! 6. D.E. Amos, \"Quadrature subroutines for splines and B-splines\", ! Report SAND79-1825, Sandia Laboratories, December 1979. module bspline_sub_module use bspline_kinds_module , only : wp , ip use , intrinsic :: iso_fortran_env , only : error_unit implicit none private abstract interface function b1fqad_func ( x ) result ( f ) !! interface for the input function in [[dbfqad]] import :: wp implicit none real ( wp ), intent ( in ) :: x real ( wp ) :: f !! f(x) end function b1fqad_func end interface public :: b1fqad_func integer ( ip ), parameter , public :: bspline_order_linear = 2_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_quadratic = 3_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_cubic = 4_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_quartic = 5_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_quintic = 6_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_hexic = 7_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_heptic = 8_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_octic = 9_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] interface db1ink !! 1D initialization routines. module procedure :: db1ink_default , db1ink_alt , db1ink_alt_2 end interface interface db1val !! 1D evaluation routines. module procedure :: db1val_default , db1val_alt end interface !main routines: public :: db1ink , db1val , db1sqad , db1fqad public :: db2ink , db2val public :: db3ink , db3val public :: db4ink , db4val public :: db5ink , db5val public :: db6ink , db6val public :: get_status_message contains !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the one-dimensional gridded data ! [x(i),\\mathrm{fcn}(i)] ~\\mathrm{for}~ i=1,..,n_x ! The interpolating function and its derivatives may ! subsequently be evaluated by the function [[db1val]]. ! !### History ! * Jacob Williams, 10/30/2015 : Created 1D routine. pure subroutine db1ink_default ( x , nx , fcn , kx , iknot , tx , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant: !! !! * If `iknot=0` these are chosen by [[db1ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( out ) :: bcoef !! `(nx)` array of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)`. !! * 706 = `size(x)` \\ne `nx`. !! * 712 = `size(tx)` \\ne `nx+kx`. !! * 800 = `size(x)` \\ne `size(bcoef,1)`. logical :: status_ok real ( wp ), dimension (:), allocatable :: work !! work array of dimension `2*kx*(nx+1)` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) end if allocate ( work ( 2_ip * kx * ( nx + 1_ip ))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , 1_ip , tx , kx , bcoef , work , iflag ) deallocate ( work ) end if end subroutine db1ink_default !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[db1ink_default]], where the boundary conditions can be specified. ! !### History ! * Jacob Williams, 9/4/2018 : created this routine. ! !### See also ! * [[dbint4]] -- the main routine that is called here. ! !@note Currently, this only works for 3rd order (k=4). pure subroutine db1ink_alt ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , kntopt , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(nx+3)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(nx+3)` real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when `k=4` real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (n=nx+2) integer ( ip ) :: k !! order of spline (k=4) logical :: status_ok !! status flag for error checking real ( wp ), dimension ( 3 ), parameter :: tleft = 0.0_wp !! not used for this case (see [[dbint4]]) real ( wp ), dimension ( 3 ), parameter :: tright = 0.0_wp !! not used for this case (see [[dbint4]]) if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5_ip , nx + 2_ip )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[db1ink_alt]], where the first and ! last 3 knots are specified by the user. ! !### History ! * Jacob Williams, 9/4/2018 : created this routine. ! !### See also ! * [[dbint4]] -- the main routine that is called here. ! !@note Currently, this only works for 3rd order (k=4). pure subroutine db1ink_alt_2 ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , tleft , tright , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! `t(1:3)` in increasing order supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! `t(nx+4:nx+6)` in increasing order supplied by the user. real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when k=4 real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (`n=nx+2`) integer ( ip ) :: k !! order of spline (`k=4`) logical :: status_ok !! status flag for error checking integer ( ip ), parameter :: kntopt = 3 !! use `tleft` and `tright` in [[dbint4]] if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5 , nx + 2 )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt_2 !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db1ink]] or one of its ! derivatives at the point `xval`. ! ! To evaluate the interpolant itself, set `idx=0`, ! to evaluate the first partial with respect to `x`, set `idx=1`, and so on. ! ! [[db1val]] returns 0.0 if (`xval`,`yval`) is out of range. that is, if !```fortran ! xval < tx(1) .or. xval > tx(nx+kx) !``` ! if the knots `tx` were chosen by [[db1ink]], then this is equivalent to: !```fortran ! xval < x(1) .or. xval > x(nx)+epsx !``` ! where !```fortran ! epsx = 0.1*(x(nx)-x(nx-1)) !``` ! ! The input quantities `tx`, `nx`, `kx`, and `bcoef` should be ! unchanged since the last call of [[db1ink]]. ! !### History ! * Jacob Williams, 10/30/2015 : Created 1D routine. pure subroutine db1val_default ( xval , idx , tx , nx , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db1ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db1ink]]) real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , nx , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_default !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[db1val_default]] for use with [[db1ink_alt]] and [[db1ink_alt_2]]. pure subroutine db1val_alt ( xval , idx , tx , nx , n , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. integer ( ip ), intent ( in ) :: n !! length of `bcoef`: `nx+2` integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), dimension ( n + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , n , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_alt !***************************************************************************************** !***************************************************************************************** !> ! Computes the integral on `(x1,x2)` of a `kx`-th order b-spline. ! Orders `kx` as high as 20 are permitted by applying a 2, 6, or 10 ! point gauss formula on subintervals of `(x1,x2)` which are ! formed by included (distinct) knots. ! !### See also ! * [[dbsqad]] -- the core routine. pure subroutine db1sqad ( tx , bcoef , nx , kx , x1 , x2 , f , iflag , w0 ) implicit none integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `1 <= k <= 20` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( out ) :: f !! integral of the b-spline over (`x1`,`x2`) integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3 * kx ), intent ( inout ) :: w0 !! work array for [[dbsqad]] call dbsqad ( tx , bcoef , nx , kx , x1 , x2 , f , w0 , iflag ) end subroutine db1sqad !***************************************************************************************** !***************************************************************************************** !> ! Computes the integral on `(x1,x2)` of a product of a ! function `fun` and the `idx`-th derivative of a `kx`-th order b-spline, ! using the b-representation `(tx,bcoef,nx,kx)`, with an adaptive ! 8-point Legendre-Gauss algorithm. ! `(x1,x2)` must be a subinterval of `t(kx) <= x <= t(nx+1)`. ! !### See also ! * [[dbfqad]] -- the core routine. ! !@note This one is not pure, because we are not enforcing ! that the user function `fun` be pure. subroutine db1fqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) implicit none procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work)` integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `kx >= 1` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: f !! integral of `bf(x)` on `(x1,x2)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array for [[dbfqad]] call dbfqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) end subroutine db1fqad !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the two-dimensional gridded data ! [x(i),y(j),\\mathrm{fcn}(i,j)] ~\\mathrm{for}~ i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y ! The interpolating function and its derivatives may ! subsequently be evaluated by the function [[db2val]]. ! ! The interpolating function is a piecewise polynomial function ! represented as a tensor product of one-dimensional b-splines. the ! form of this function is ! ! s(x,y) = \\sum_{i=1}^{n_x} \\sum_{j=1}^{n_y} a_{ij} u_i(x) v_j(y) ! ! where the functions u_i and v_j are one-dimensional b-spline ! basis functions. the coefficients a_{ij} are chosen so that ! ! s(x(i),y(j)) = \\mathrm{fcn}(i,j) ~\\mathrm{for}~ i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y ! ! Note that for each fixed value of y, s(x,y) is a piecewise ! polynomial function of x alone, and for each fixed value of x, s(x,y) ! is a piecewise polynomial function of y alone. in one dimension ! a piecewise polynomial may be created by partitioning a given ! interval into subintervals and defining a distinct polynomial piece ! on each one. the points where adjacent subintervals meet are called ! knots. each of the functions u_i and v_j above is a piecewise ! polynomial. ! ! Users of [[db2ink]] choose the order (degree+1) of the polynomial ! pieces used to define the piecewise polynomial in each of the x and ! y directions (`kx` and `ky`). users also may define their own knot ! sequence in x and y separately (`tx` and `ty`). if `iflag=0`, however, ! [[db2ink]] will choose sequences of knots that result in a piecewise ! polynomial interpolant with `kx-2` continuous partial derivatives in ! x and `ky-2` continuous partial derivatives in y. (`kx` knots are taken ! near each endpoint in the x direction, not-a-knot end conditions ! are used, and the remaining knots are placed at data points if `kx` ! is even or at midpoints between data points if `kx` is odd. the y ! direction is treated similarly.) ! ! After a call to [[db2ink]], all information necessary to define the ! interpolating function are contained in the parameters `nx`, `ny`, `kx`, ! `ky`, `tx`, `ty`, and `bcoef`. These quantities should not be altered until ! after the last call of the evaluation routine [[db2val]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , tx , ty , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: ny !! Number of y abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:), intent ( out ) :: bcoef !! `(nx,ny)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1),2*ky*(ny+1))` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny ,& kx = kx , ky = ky ,& x = x , y = y ,& tx = tx , ty = ty ,& f2 = fcn ,& bcoef2 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) end if allocate ( temp ( nx * ny )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip )))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx , ty , ky , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db2ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db2ink]] or one of its ! derivatives at the point (`xval`,`yval`). ! ! To evaluate the interpolant ! itself, set `idx=idy=0`, to evaluate the first partial with respect ! to `x`, set `idx=1,idy=0`, and so on. ! ! [[db2val]] returns 0.0 if `(xval,yval)` is out of range. that is, if !```fortran ! xval < tx(1) .or. xval > tx(nx+kx) .or. ! yval < ty(1) .or. yval > ty(ny+ky) !``` ! if the knots tx and ty were chosen by [[db2ink]], then this is equivalent to: !```fortran ! xval < x(1) .or. xval > x(nx)+epsx .or. ! yval < y(1) .or. yval > y(ny)+epsy !``` ! where !```fortran ! epsx = 0.1*(x(nx)-x(nx-1)) ! epsy = 0.1*(y(ny)-y(ny-1)) !``` ! ! The input quantities `tx`, `ty`, `nx`, `ny`, `kx`, `ky`, and `bcoef` should be ! unchanged since the last call of [[db2ink]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db2val ( xval , yval , idx , idy , tx , ty , nx , ny , kx , ky , bcoef , f , iflag , inbvx , inbvy , iloy , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db2ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise !! polynomial in the y direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( nx , ny ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db2ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: k , lefty , kcol f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return kcol = lefty - ky do k = 1_ip , ky kcol = kcol + 1_ip call dbvalu ( tx , bcoef (:, kcol ), nx , kx , idx , xval , inbvx , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return !error end do kcol = lefty - ky + 1_ip call dbvalu ( ty ( kcol :), w1 , ky , ky , idy , yval , inbvy , w0 , iflag , f , extrap ) end subroutine db2val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the three-dimensional gridded data ! [x(i),y(j),z(k),\\mathrm{fcn}(i,j,k)] ~\\mathrm{for}~ ! i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y, ~\\mathrm{and}~ k=1,..,n_z ! The interpolating function and ! its derivatives may subsequently be evaluated by the function ! [[db3val]]. ! ! The interpolating function is a piecewise polynomial function ! represented as a tensor product of one-dimensional b-splines. the ! form of this function is ! s(x,y,z) = \\sum_{i=1}^{n_x} \\sum_{j=1}^{n_y} \\sum_{k=1}^{n_z} ! a_{ijk} u_i(x) v_j(y) w_k(z) ! ! where the functions u_i, v_j, and w_k are one-dimensional b- ! spline basis functions. the coefficients a_{ijk} are chosen so that: ! ! s(x(i),y(j),z(k)) = \\mathrm{fcn}(i,j,k) ! ~\\mathrm{for}~ i=1,..,n_x , j=1,..,n_y , k=1,..,n_z ! ! Note that for fixed values of y and z s(x,y,z) is a piecewise ! polynomial function of x alone, for fixed values of x and z s(x,y,z) ! is a piecewise polynomial function of y alone, and for fixed ! values of x and y s(x,y,z) is a function of z alone. in one ! dimension a piecewise polynomial may be created by partitioning a ! given interval into subintervals and defining a distinct polynomial ! piece on each one. the points where adjacent subintervals meet are ! called knots. each of the functions u_i, v_j, and w_k above is a ! piecewise polynomial. ! ! Users of [[db3ink]] choose the order (degree+1) of the polynomial ! pieces used to define the piecewise polynomial in each of the x, y, ! and z directions (`kx`, `ky`, and `kz`). users also may define their own ! knot sequence in x, y, z separately (`tx`, `ty`, and `tz`). if `iflag=0`, ! however, [[db3ink]] will choose sequences of knots that result in a ! piecewise polynomial interpolant with `kx-2` continuous partial ! derivatives in x, `ky-2` continuous partial derivatives in y, and `kz-2` ! continuous partial derivatives in z. (`kx` knots are taken near ! each endpoint in x, not-a-knot end conditions are used, and the ! remaining knots are placed at data points if `kx` is even or at ! midpoints between data points if `kx` is odd. the y and z directions ! are treated similarly.) ! ! After a call to [[db3ink]], all information necessary to define the ! interpolating function are contained in the parameters `nx`, `ny`, `nz`, ! `kx`, `ky`, `kz`, `tx`, `ty`, `tz`, and `bcoef`. these quantities should not be ! altered until after the last call of the evaluation routine [[db3val]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db3ink ( x , nx , y , ny , z , nz , fcn , kx , ky , kz , iknot , tx , ty , tz , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. `fcn(i,j,k)` should !! contain the function value at the point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db3ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `ty` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1))` integer ( ip ) :: i , j , k , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz ,& kx = kx , ky = ky , kz = kz ,& x = x , y = y , z = z ,& tx = tx , ty = ty , tz = tz ,& f3 = fcn ,& bcoef3 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) end if allocate ( temp ( nx * ny * nz )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp = reshape( fcn, [nx*ny*nz] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k ) end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny , tz , kz , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db3ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db3ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=0`, to evaluate the first ! partial with respect to `x`, set `idx=1`,`idy=idz=0`, and so on. ! ! [[db3val]] returns 0.0 if (`xval`,`yval`,`zval`) is out of range. that is, !```fortran ! xvaltx(nx+kx) .or. ! yvalty(ny+ky) .or. ! zvaltz(nz+kz) !``` ! if the knots `tx`, `ty`, and `tz` were chosen by [[db3ink]], then this is ! equivalent to !```fortran ! xvalx(nx)+epsx .or. ! yvaly(ny)+epsy .or. ! zvalz(nz)+epsz !``` ! where !```fortran ! epsx = 0.1*(x(nx)-x(nx-1)) ! epsy = 0.1*(y(ny)-y(ny-1)) ! epsz = 0.1*(z(nz)-z(nz-1)) !``` ! ! The input quantities `tx`, `ty`, `tz`, `nx`, `ny`, `nz`, `kx`, `ky`, `kz`, and `bcoef` ! should remain unchanged since the last call of [[db3ink]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db3val ( xval , yval , zval , idx , idy , idz ,& tx , ty , tz ,& nx , ny , nz , kx , ky , kz , bcoef , f , iflag ,& inbvx , inbvy , inbvz , iloy , iloz , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nx , ny , nz ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db3ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kz ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , kcoly , kcolz , j , k f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz ), nx , kx , idx , xval , inbvx , w0 , iflag , w2 ( j , k ), extrap ) if ( iflag /= 0_ip ) return end do end do kcoly = lefty - ky + 1_ip do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w2 (:, k ), ky , ky , idy , yval , inbvy , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return end do kcolz = leftz - kz + 1_ip call dbvalu ( tz ( kcolz :), w1 , kz , kz , idz , zval , inbvz , w0 , iflag , f , extrap ) end subroutine db3val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the four-dimensional gridded data ! [x(i),y(j),z(k),q(l),\\mathrm{fcn}(i,j,k,l)] ~\\mathrm{for}~ ! i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y, ~\\mathrm{and}~ k=1,..,n_z, ! ~\\mathrm{and}~ l=1,..,n_q ! The interpolating function and its derivatives may ! subsequently be evaluated by the function [[db4val]]. ! ! See [[db3ink]] header for more details. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& tx , ty , tz , tq ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,q)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db4ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 712 = `size(tx`) \\ne `nx+kx` !! * 713 = `size(ty`) \\ne `ny+ky` !! * 714 = `size(tz`) \\ne `nz+kz` !! * 715 = `size(tq`) \\ne `nq+kq` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of dimension `nx*ny*nz*nq` real ( wp ), dimension (:), allocatable :: work !! work array of dimension `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq ,& kx = kx , ky = ky , kz = kz , kq = kq ,& x = x , y = y , z = z , q = q ,& tx = tx , ty = ty , tz = tz , tq = tq ,& f4 = fcn ,& bcoef4 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) end if allocate ( temp ( nx * ny * nz * nq )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz , tq , kq , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db4ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db4ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`,`qval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=idq=0`, to evaluate the first ! partial with respect to `x`, set `idx=1,idy=idz=idq=0`, and so on. ! ! See [[db3val]] header for more information. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& tx , ty , tz , tq ,& nx , ny , nz , nq ,& kx , ky , kz , kq ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq ,& iloy , iloz , iloq , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db4ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nx , ny , nz , nq ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db4ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kz , kq ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kq ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , & kcoly , kcolz , kcolq , j , k , q f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w3 ( j , k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! y -> z, q kcoly = lefty - ky + 1_ip do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w3 (:, k , q ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w2 ( k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do ! z -> q kcolz = leftz - kz + 1_ip do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w2 (:, q ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w1 ( q ), extrap ) if ( iflag /= 0_ip ) return end do ! q kcolq = leftq - kq + 1_ip call dbvalu ( tq ( kcolq :), w1 , kq , kq , idq , qval , inbvq , w0 , iflag , f , extrap ) end subroutine db4val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the five-dimensional gridded data: ! ! [x(i),y(j),z(k),q(l),r(m),\\mathrm{fcn}(i,j,k,l,m)] ! ! for: ! ! i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y, ~\\mathrm{and}~ k=1,..,n_z, ! ~\\mathrm{and}~ l=1,..,n_q, ~\\mathrm{and}~ m=1,..,n_r ! ! The interpolating function and its derivatives may subsequently be evaluated ! by the function [[db5val]]. ! ! See [[db3ink]] header for more details. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& tx , ty , tz , tq , tr ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,q,r)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db5ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 704 = `size(r)` \\ne `size(fcn,5)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 710 = `size(r)` \\ne `nr` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` !! * 804 = `size(r)` \\ne `size(bcoef,5)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz*nq*nr` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1),2*kr*(nr+1))` integer ( ip ) :: i , j , k , l , m , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr ,& x = x , y = y , z = z , q = q , r = r ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr ,& f5 = fcn ,& bcoef5 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) end if allocate ( temp ( nx * ny * nz * nq * nr )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ), 2_ip * kr * ( nr + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp(1:nx*ny*nz*nq*nr) = reshape( fcn, [nx*ny*nz*nq*nr] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do m = 1_ip , nr do l = 1_ip , nq do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k , l , m ) end do end do end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz * nq * nr , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz * nq * nr , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny * nq * nr , tz , kz , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , bcoef , nq , nx * ny * nz * nr , tq , kq , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , temp , nr , nx * ny * nz * nq , tr , kr , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db5ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db5ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`,`qval`,`rval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=idq=idr=0`, to evaluate the first ! partial with respect to `x`, set `idx=1,idy=idz=idq=idr=0,` and so on. ! ! See [[db3val]] header for more information. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& tx , ty , tz , tq , tr ,& nx , ny , nz , nq , nr ,& kx , ky , kz , kq , kr ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr ,& iloy , iloz , iloq , ilor ,& w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db5ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db5ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kz , kq , kr ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kq , kr ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kr ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , & kcoly , kcolz , kcolq , kcolr , j , k , q , r f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr ),& nx , kx , idx , xval , inbvx , w0 , iflag , w4 ( j , k , q , r ),& extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! y -> z, q, r kcoly = lefty - ky + 1_ip do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w4 (:, k , q , r ), ky , ky , idy , yval , inbvy ,& w0 , iflag , w3 ( k , q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! z -> q, r kcolz = leftz - kz + 1_ip do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w3 (:, q , r ), kz , kz , idz , zval , inbvz ,& w0 , iflag , w2 ( q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do ! q -> r kcolq = leftq - kq + 1_ip do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w2 (:, r ), kq , kq , idq , qval , inbvq ,& w0 , iflag , w1 ( r ), extrap ) if ( iflag /= 0_ip ) return end do ! r kcolr = leftr - kr + 1_ip call dbvalu ( tr ( kcolr :), w1 , kr , kr , idr , rval , inbvr , w0 , iflag , f , extrap ) end subroutine db5val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the six-dimensional gridded data: ! ! [x(i),y(j),z(k),q(l),r(m),s(n),\\mathrm{fcn}(i,j,k,l,m,n)] ! ! for: ! ! i=1,..,n_x, j=1,..,n_y, k=1,..,n_z, l=1,..,n_q, m=1,..,n_r, n=1,..,n_s ! ! the interpolating function and its derivatives may subsequently be evaluated ! by the function [[db6val]]. ! ! See [[db3ink]] header for more details. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& tx , ty , tz , tq , tr , ts ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ns !! number of s abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! the order of spline pieces in s !! ( 2 \\le k_s < n_s ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. !! must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to !! interpolate. `fcn(i,j,k,q,r,s)` should contain the !! function value at the point !! (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db6ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the !! spline interpolant. !! !! * f `iknot=0` these are chosen by [[db6ink]]. !! * f `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ts !! The `(ns+ks)` knots in the s direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr,ns)` matrix of coefficients of the !! b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 23 = `ns` out of range. !! * 24 = `ks` out of range. !! * 25 = `s` not strictly increasing. !! * 26 = `ts` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 703 = `size(q) ` \\ne `size(fcn,4)` !! * 704 = `size(r) ` \\ne `size(fcn,5)` !! * 705 = `size(s) ` \\ne `size(fcn,6)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 709 = `size(q) ` \\ne `nq` !! * 710 = `size(r) ` \\ne `nr` !! * 711 = `size(s) ` \\ne `ns` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 717 = `size(ts)` \\ne `ns+ks` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` !! * 803 = `size(q) ` \\ne `size(bcoef,4)` !! * 804 = `size(r) ` \\ne `size(bcoef,5)` !! * 805 = `size(s) ` \\ne `size(bcoef,6)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of size `nx*ny*nz*nq*nr*ns` real ( wp ), dimension (:), allocatable :: work !! work array of size `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1), !! 2*kr*(nr+1),2*ks*(ns+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr , ns = ns ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr , ks = ks ,& x = x , y = y , z = z , q = q , r = r , s = s ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr , ts = ts ,& f6 = fcn ,& bcoef6 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) call dbknot ( s , ns , ks , ts ) end if allocate ( temp ( nx * ny * nz * nq * nr * ns )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ),& 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ),& 2_ip * kr * ( nr + 1_ip ), 2_ip * ks * ( ns + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq * nr * ns , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq * nr * ns , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq * nr * ns , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz * nr * ns , tq , kq , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , bcoef , nr , nx * ny * nz * nq * ns , tr , kr , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( s , ns , temp , ns , nx * ny * nz * nq * nr , ts , ks , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db6ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db6ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`,`qval`,`rval`,`sval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=idq=idr=ids=0`, to evaluate the first ! partial with respect to `x`, set `idx=1,idy=idz=idq=idr=ids=0`, and so on. ! ! See [[db3val]] header for more information. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& tx , ty , tz , tq , tr , ts ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr , inbvs ,& iloy , iloz , iloq , ilor , ilos ,& w5 , w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ns !! the number of interpolation points in s. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ks !! order of polynomial pieces in s. !! (same as in last call to [[db6ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ns + ks ), intent ( in ) :: ts !! sequence of knots defining the piecewise polynomial !! in the s direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr , ns ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db6ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvs !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilos !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr , ks ), intent ( inout ) :: w5 !! work array real ( wp ), dimension ( kz , kq , kr , ks ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kq , kr , ks ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kr , ks ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( ks ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr , ks )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , lefts ,& kcoly , kcolz , kcolq , kcolr , kcols ,& j , k , q , r , s f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( sval , ts , 6_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ts , ns + ks , sval , ilos , lefts , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r, s kcols = lefts - ks do s = 1_ip , ks kcols = kcols + 1_ip kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr , kcols ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w5 ( j , k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do end do ! y -> z, q, r, s kcoly = lefty - ky + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w5 (:, k , q , r , s ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w4 ( k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! z -> q, r, s kcolz = leftz - kz + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w4 (:, q , r , s ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w3 ( q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! q -> r, s kcolq = leftq - kq + 1_ip do s = 1_ip , ks do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w3 (:, r , s ),& kq , kq , idq , qval , inbvq , w0 , iflag ,& w2 ( r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do ! r -> s kcolr = leftr - kr + 1_ip do s = 1_ip , ks call dbvalu ( tr ( kcolr :), w2 (:, s ),& kr , kr , idr , rval , inbvr , w0 , iflag ,& w1 ( s ), extrap ) if ( iflag /= 0_ip ) return end do ! s kcols = lefts - ks + 1_ip call dbvalu ( ts ( kcols :), w1 , ks , ks , ids , sval , inbvs , w0 , iflag , f , extrap ) end subroutine db6val !***************************************************************************************** !***************************************************************************************** !> ! Checks if the value is withing the range of the knot vectors. ! This is called by the various `db*val` routines. pure function check_value ( x , t , i , extrap ) result ( iflag ) implicit none integer ( ip ) :: iflag !! returns 0 if value is OK, otherwise returns `600+i` real ( wp ), intent ( in ) :: x !! the value to check integer ( ip ), intent ( in ) :: i !! 1=x, 2=y, 3=z, 4=q, 5=r, 6=s real ( wp ), dimension (:), intent ( in ) :: t !! the knot vector logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: allow_extrapolation !! if extrapolation is allowed if ( present ( extrap )) then allow_extrapolation = extrap else allow_extrapolation = . false . end if if ( allow_extrapolation ) then ! in this case all values are OK iflag = 0_ip else if ( x < t ( 1_ip ) . or . x > t ( size ( t , kind = ip ))) then iflag = 600_ip + i ! value out of bounds (601, 602, etc.) else iflag = 0_ip end if end if end function check_value !***************************************************************************************** !***************************************************************************************** !> ! Check the validity of the inputs to the `db*ink` routines. ! Prints warning message if there is an error, ! and also sets iflag and status_ok. ! ! Supports up to 6D: `x`,`y`,`z`,`q`,`r`,`s` ! !### Notes ! ! The code is new, but the logic is based on the original ! logic in the CMLIB routines `db2ink` and `db3ink`. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine check_inputs ( iknot ,& iflag ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& x , y , z , q , r , s ,& tx , ty , tz , tq , tr , ts ,& f1 , f2 , f3 , f4 , f5 , f6 ,& bcoef1 , bcoef2 , bcoef3 , bcoef4 , bcoef5 , bcoef6 ,& alt ,& status_ok ) implicit none integer ( ip ), intent ( in ) :: iknot !! = 0 if the `INK` routine is computing the knots. integer ( ip ), intent ( out ) :: iflag integer ( ip ), intent ( in ), optional :: nx , ny , nz , nq , nr , ns integer ( ip ), intent ( in ), optional :: kx , ky , kz , kq , kr , ks real ( wp ), dimension (:), intent ( in ), optional :: x , y , z , q , r , s real ( wp ), dimension (:), intent ( in ), optional :: tx , ty , tz , tq , tr , ts real ( wp ), dimension (:), intent ( in ), optional :: f1 , bcoef1 real ( wp ), dimension (:,:), intent ( in ), optional :: f2 , bcoef2 real ( wp ), dimension (:,:,:), intent ( in ), optional :: f3 , bcoef3 real ( wp ), dimension (:,:,:,:), intent ( in ), optional :: f4 , bcoef4 real ( wp ), dimension (:,:,:,:,:), intent ( in ), optional :: f5 , bcoef5 real ( wp ), dimension (:,:,:,:,:,:), intent ( in ), optional :: f6 , bcoef6 logical , intent ( in ), optional :: alt !! using the alt routine where 1st or !! 2nd deriv is fixed at endpoints !! [default is False] logical , intent ( out ) :: status_ok logical :: error integer :: iex !! extra points for the alt case (in `t` and `bcoef`) !! [currently, only allowed for the 1D case & `k=4`] status_ok = . false . iex = 0_ip ! default if ( present ( alt )) then if ( alt ) iex = 2_ip ! for \"alt\" mode end if if (( iknot < 0_ip ) . or . ( iknot > 1_ip )) then iflag = 2_ip ! iknot is out of range else call check ( 'x' , nx , kx , x , tx ,[ 3_ip , 4_ip , 5_ip , 6_ip , 706_ip , 712_ip ], iflag , error , iex ); if ( error ) return call check ( 'y' , ny , ky , y , ty ,[ 7_ip , 8_ip , 9_ip , 10_ip , 707_ip , 713_ip ], iflag , error , iex ); if ( error ) return call check ( 'z' , nz , kz , z , tz ,[ 11_ip , 12_ip , 13_ip , 14_ip , 708_ip , 714_ip ], iflag , error , iex ); if ( error ) return call check ( 'q' , nq , kq , q , tq ,[ 15_ip , 16_ip , 17_ip , 18_ip , 709_ip , 715_ip ], iflag , error , iex ); if ( error ) return call check ( 'r' , nr , kr , r , tr ,[ 19_ip , 20_ip , 21_ip , 22_ip , 710_ip , 716_ip ], iflag , error , iex ); if ( error ) return call check ( 's' , ns , ks , s , ts ,[ 23_ip , 24_ip , 25_ip , 26_ip , 711_ip , 717_ip ], iflag , error , iex ); if ( error ) return if ( present ( x ) . and . present ( f1 ) . and . present ( bcoef1 )) then if ( size ( x , kind = ip ) /= size ( f1 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef1 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( f2 ) . and . present ( bcoef2 )) then if ( size ( x , kind = ip ) /= size ( f2 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f2 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef2 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef2 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( f3 ) . and . & present ( bcoef3 )) then if ( size ( x , kind = ip ) /= size ( f3 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f3 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f3 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef3 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef3 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef3 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( f4 ) . and . present ( bcoef4 )) then if ( size ( x , kind = ip ) /= size ( f4 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f4 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f4 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f4 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef4 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef4 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef4 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef4 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( f5 ) . and . present ( bcoef5 )) then if ( size ( x , kind = ip ) /= size ( f5 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f5 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f5 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f5 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f5 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef5 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef5 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef5 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef5 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef5 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( s ) . and . present ( f6 ) . and . present ( bcoef6 )) then if ( size ( x , kind = ip ) /= size ( f6 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f6 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f6 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f6 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f6 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( s , kind = ip ) /= size ( f6 , 6_ip , kind = ip )) then ; iflag = 705_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef6 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef6 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef6 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef6 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef6 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if if ( size ( s , kind = ip ) + iex /= size ( bcoef6 , 6_ip , kind = ip )) then ; iflag = 805_ip ; return ; end if end if status_ok = . true . iflag = 0_ip end if contains pure subroutine check ( s , n , k , x , t , ierrs , iflag , error , ik ) !! check `t`,`x`,`n`,`k` for validity implicit none character ( len = 1 ), intent ( in ) :: s !! coordinate string: 'x','y','z','q','r','s' integer ( ip ), intent ( in ), optional :: n !! size of `x` integer ( ip ), intent ( in ), optional :: k !! order real ( wp ), dimension (:), intent ( in ), optional :: x !! abcissae vector real ( wp ), dimension (:), intent ( in ), optional :: t !! knot vector `size(n+k)` integer ( ip ), dimension (:), intent ( in ) :: ierrs !! int error codes for `n`,`k`,`x`,`t`, !! `size(x)`,`size(t)` checks integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error !! true if there was an error integer , intent ( in ) :: ik !! add this value to k integer ( ip ), dimension ( 2 ) :: itmp !! temp integer array if ( present ( n ) . and . present ( k ) . and . present ( x ) . and . present ( t )) then itmp = [ ierrs ( 1_ip ), ierrs ( 5 )] call check_n ( 'n' // s , n , x , itmp , iflag , error ); if ( error ) return call check_k ( 'k' // s , k + ik , n , ierrs ( 2 ), iflag , error ); if ( error ) return call check_x ( s , n , x , ierrs ( 3 ), iflag , error ); if ( error ) return if ( iknot /= 0_ip ) then itmp = [ ierrs ( 4 ), ierrs ( 6 )] call check_t ( 't' // s , n , k + ik , t , itmp , iflag , error ); if ( error ) return end if end if end subroutine check pure subroutine check_n ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x !! abcissae vector integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [n<3 check, size(x)==n check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if ( n < 3_ip ) then iflag = ierr ( 1_ip ) error = . true . else if ( size ( x ) /= n ) then iflag = ierr ( 2 ) error = . true . else error = . false . end if end if end subroutine check_n pure subroutine check_k ( s , k , n , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: k integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if (( k < 2_ip ) . or . ( k >= n )) then iflag = ierr error = . true . else error = . false . end if end subroutine check_k pure subroutine check_x ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . do i = 2_ip , n if ( x ( i ) <= x ( i - 1_ip )) then iflag = ierr return end if end do error = . false . end subroutine check_x pure subroutine check_t ( s , n , k , t , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: t integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [non-decreasing check, size check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . if ( size ( t ) /= ( n + k )) then iflag = ierr ( 2 ) return end if if ( iex == 0_ip ) then ! don't do this for \"alt\" mode since they haven't been computed yet do i = 2_ip , n + k if ( t ( i ) < t ( i - 1_ip )) then iflag = ierr ( 1_ip ) return end if end do end if error = . false . end subroutine check_t end subroutine check_inputs !***************************************************************************************** !***************************************************************************************** !> ! dbknot chooses a knot sequence for interpolation of order k at the ! data points x(i), i=1,..,n. the n+k knots are placed in the array ! t. k knots are placed at each endpoint and not-a-knot end ! conditions are used. the remaining knots are placed at data points ! if n is even and between data points if n is odd. the rightmost ! knot is shifted slightly to the right to insure proper interpolation ! at x(n) (see page 350 of the reference). ! !### History ! * Jacob Williams, 2/24/2015 : Refactored this routine. pure subroutine dbknot ( x , n , k , t ) implicit none integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension (:), intent ( out ) :: t integer ( ip ) :: i , j , ipj , npj , ip1 , jstrt real ( wp ) :: rnot !put k knots at each endpoint !(shift right endpoints slightly -- see pg 350 of reference) rnot = x ( n ) + 0.1_wp * ( x ( n ) - x ( n - 1_ip ) ) do j = 1_ip , k t ( j ) = x ( 1_ip ) npj = n + j t ( npj ) = rnot end do !distribute remaining knots if ( mod ( k , 2_ip ) == 1_ip ) then !case of odd k -- knots between data points i = ( k - 1_ip ) / 2_ip - k ip1 = i + 1_ip jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = 0.5_wp * ( x ( ipj ) + x ( ipj + 1_ip ) ) end do else !case of even k -- knots at data points i = ( k / 2_ip ) - k jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = x ( ipj ) end do end if end subroutine dbknot !***************************************************************************************** !***************************************************************************************** !> ! dbtpcf computes b-spline interpolation coefficients for nf sets ! of data stored in the columns of the array fcn. the b-spline ! coefficients are stored in the rows of bcoef however. ! each interpolation is based on the n abcissa stored in the ! array x, and the n+k knots stored in the array t. the order ! of each interpolation is k. ! !### History ! * Jacob Williams, 2/24/2015 : Refactored this routine. pure subroutine dbtpcf ( x , n , fcn , ldf , nf , t , k , bcoef , work , iflag ) integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: nf integer ( ip ), intent ( in ) :: ldf integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension ( ldf , nf ), intent ( in ) :: fcn real ( wp ), dimension (:), intent ( in ) :: t real ( wp ), dimension ( nf , n ), intent ( out ) :: bcoef real ( wp ), dimension ( * ), intent ( out ) :: work !! work array of size >= `2*k*(n+1)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 301: n should be >0 integer ( ip ) :: i , j , m1 , m2 , iq , iw ! check for null input if ( nf > 0_ip ) then ! partition work array m1 = k - 1_ip m2 = m1 + k iq = 1_ip + n iw = iq + m2 * n + 1_ip ! compute b-spline coefficients ! first data set call dbintk ( x , fcn , t , n , k , work , work ( iq ), work ( iw ), iflag ) if ( iflag == 0_ip ) then do i = 1_ip , n bcoef ( 1_ip , i ) = work ( i ) end do ! all remaining data sets by back-substitution if ( nf == 1_ip ) return do j = 2_ip , nf do i = 1_ip , n work ( i ) = fcn ( i , j ) end do call dbnslv ( work ( iq ), m2 , n , m1 , m1 , work ) do i = 1_ip , n bcoef ( j , i ) = work ( i ) end do end do end if else !write(error_unit,'(A)') 'dbtpcf - n should be >0' iflag = 301_ip end if end subroutine dbtpcf !***************************************************************************************** !***************************************************************************************** !> ! dbintk produces the b-spline coefficients, bcoef, of the ! b-spline of order k with knots t(i), i=1,...,n+k, which ! takes on the value y(i) at x(i), i=1,...,n. the spline or ! any of its derivatives can be evaluated by calls to [[dbvalu]]. ! ! the i-th equation of the linear system a*bcoef = b for the ! coefficients of the interpolant enforces interpolation at ! x(i), i=1,...,n. hence, b(i) = y(i), for all i, and a is ! a band matrix with 2k-1 bands if a is invertible. the matrix ! a is generated row by row and stored, diagonal by diagonal, ! in the rows of q, with the main diagonal going into row k. ! the banded system is then solved by a call to dbnfac (which ! constructs the triangular factorization for a and stores it ! again in q), followed by a call to dbnslv (which then ! obtains the solution bcoef by substitution). dbnfac does no ! pivoting, since the total positivity of the matrix a makes ! this unnecessary. the linear system to be solved is ! (theoretically) invertible if and only if ! t(i) < x(i) < t(i+k), for all i. ! equality is permitted on the left for i=1 and on the right ! for i=n when k knots are used at x(1) or x(n). otherwise, ! violation of this condition is certain to lead to an error. ! !### Error conditions ! ! * improper input ! * singular system of equations ! !### History ! * splint written by carl de boor [5] ! * dbintk author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * 000330 modified array declarations. (jec) ! * Jacob Williams, 5/10/2015 : converted to free-form Fortran. pure subroutine dbintk ( x , y , t , n , k , bcoef , q , work , iflag ) implicit none integer ( ip ), intent ( in ) :: n !! number of data points, n >= k real ( wp ), dimension ( n ), intent ( in ) :: x !! vector of length n containing data point abscissa !! in strictly increasing order. real ( wp ), dimension ( n ), intent ( in ) :: y !! corresponding vector of length n containing data !! point ordinates. real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length n+k !! since t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) !! >= x(n), this leaves only n-k knots (not !! necessarily x(i) values) interior to (x(1),x(n)) integer ( ip ), intent ( in ) :: k !! order of the spline, k >= 1 real ( wp ), dimension ( n ), intent ( out ) :: bcoef !! a vector of length n containing the b-spline coefficients real ( wp ), dimension ( * ), intent ( out ) :: q !! a work vector of length (2*k-1)*n, containing !! the triangular factorization of the coefficient !! matrix of the linear system being solved. the !! coefficients for the interpolant of an !! additional data set (x(i),yy(i)), i=1,...,n !! with the same abscissa can be obtained by loading !! yy into bcoef and then executing !! call dbnslv(q,2k-1,n,k-1,k-1,bcoef) real ( wp ), dimension ( * ), intent ( out ) :: work !! work vector of length 2*k integer ( ip ), intent ( out ) :: iflag !! * 0: no errors. !! * 100: k does not satisfy k>=1. !! * 101: n does not satisfy n>=k. !! * 102: x(i) does not satisfy x(i)=1' iflag = 100_ip return end if if ( n < k ) then !write(error_unit,'(A)') 'dbintk - n does not satisfy n>=k' iflag = 101_ip return end if jj = n - 1_ip if ( jj /= 0_ip ) then do i = 1_ip , jj if ( x ( i ) >= x ( i + 1_ip )) then !write(error_unit,'(A)') 'dbintk - x(i) does not satisfy x(i)= ilp1mx ) exit end do if (. not . found ) then left = left - 1_ip if ( xi > t ( left + 1_ip )) then !write(error_unit,'(A)') 'dbintk - some abscissa was not in the support of the'//& ! ' corresponding basis function and the system is singular' iflag = 103_ip return end if end if ! the i-th equation enforces interpolation at xi, hence ! a(i,j) = b(j,k,t)(xi), all j. only the k entries with j = ! left-k+1,...,left actually might be nonzero. these k numbers ! are returned, in bcoef (used for temp.storage here), by the ! following call dbspvn ( t , k , k , 1_ip , xi , left , bcoef , work , iwork , iflag ) if ( iflag /= 0_ip ) return ! we therefore want bcoef(j) = b(left-k+j)(xi) to go into ! a(i,left-k+j), i.e., into q(i-(left+j)+2*k,(left+j)-k) since ! a(i+j,j) is to go into q(i+k,j), all i,j, if we consider q ! as a two-dim. array , with 2*k-1 rows (see comments in ! dbnfac). in the present program, we treat q as an equivalent ! one-dimensional array (because of fortran restrictions on ! dimension statements) . we therefore want bcoef(j) to go into ! entry ! i -(left+j) + 2*k + ((left+j) - k-1)*(2*k-1) ! = i-left+1 + (left -k)*(2*k-1) + (2*k-2)*j ! of q. jj = i - left + 1_ip + ( left - k ) * ( k + km1 ) do j = 1_ip , k jj = jj + kpkm2 q ( jj ) = bcoef ( j ) end do end do ! obtain factorization of a, stored again in q. call dbnfac ( q , k + km1 , n , km1 , km1 , iflag ) if ( iflag == 1 ) then !success ! solve a*bcoef = y by backsubstitution do i = 1_ip , n bcoef ( i ) = y ( i ) end do call dbnslv ( q , k + km1 , n , km1 , km1 , bcoef ) iflag = 0_ip else !failure !write(error_unit,'(A)') 'dbintk - the system of solver detects a singular system'//& ! ' although the theoretical conditions for a solution were satisfied' iflag = 104_ip end if end subroutine dbintk !***************************************************************************************** !***************************************************************************************** !> ! Returns in w the LU-factorization (without pivoting) of the banded ! matrix a of order nrow with (nbandl + 1 + nbandu) bands or diagonals ! in the work array w . ! ! gauss elimination without pivoting is used. the routine is ! intended for use with matrices a which do not require row inter- ! changes during factorization, especially for the totally ! positive matrices which occur in spline calculations. ! the routine should not be used for an arbitrary banded matrix. ! !### Work array ! ! **Input** ! ! w array of size (nroww,nrow) contains the interesting ! part of a banded matrix a , with the diagonals or bands of a ! stored in the rows of w , while columns of a correspond to ! columns of w . this is the storage mode used in linpack and ! results in efficient innermost loops. ! explicitly, a has nbandl bands below the diagonal ! + 1 (main) diagonal ! + nbandu bands above the diagonal ! and thus, with middle = nbandu + 1, ! a(i+j,j) is in w(i+middle,j) for i=-nbandu,...,nbandl ! j=1,...,nrow . ! for example, the interesting entries of a (1,2)-banded matrix ! of order 9 would appear in the first 1+1+2 = 4 rows of w ! as follows. ! 13 24 35 46 57 68 79 ! 12 23 34 45 56 67 78 89 ! 11 22 33 44 55 66 77 88 99 ! 21 32 43 54 65 76 87 98 ! ! all other entries of w not identified in this way with an en- ! try of a are never referenced . ! ! **Output** ! ! * if iflag = 1, then ! w contains the lu-factorization of a into a unit lower triangu- ! lar matrix l and an upper triangular matrix u (both banded) ! and stored in customary fashion over the corresponding entries ! of a . this makes it possible to solve any particular linear ! system a*x = b for x by a ! call dbnslv ( w, nroww, nrow, nbandl, nbandu, b ) ! with the solution x contained in b on return . ! * if iflag = 2, then ! one of nrow-1, nbandl,nbandu failed to be nonnegative, or else ! one of the potential pivots was found to be zero indicating ! that a does not have an lu-factorization. this implies that ! a is singular in case it is totally positive . ! !### History ! * banfac written by carl de boor [5] ! * dbnfac from CMLIB [1] ! * Jacob Williams, 5/10/2015 : converted to free-form Fortran. pure subroutine dbnfac ( w , nroww , nrow , nbandl , nbandu , iflag ) integer ( ip ), intent ( in ) :: nroww !! row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer ( ip ), intent ( in ) :: nrow !! matrix order integer ( ip ), intent ( in ) :: nbandl !! number of bands of a below the main diagonal integer ( ip ), intent ( in ) :: nbandu !! number of bands of a above the main diagonal integer ( ip ), intent ( out ) :: iflag !! indicating success(=1) or failure (=2) real ( wp ), dimension ( nroww , nrow ), intent ( inout ) :: w !! work array. See header for details. integer ( ip ) :: i , ipk , j , jmax , k , kmax , middle , midmk , nrowm1 real ( wp ) :: factor , pivot iflag = 1_ip middle = nbandu + 1_ip ! w(middle,.) contains the main diagonal of a. nrowm1 = nrow - 1_ip if ( nrowm1 < 0_ip ) then iflag = 2_ip return else if ( nrowm1 == 0_ip ) then if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandl <= 0_ip ) then ! a is upper triangular. check that diagonal is nonzero . do i = 1_ip , nrowm1 if ( w ( middle , i ) == 0.0_wp ) then iflag = 2_ip return end if end do if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandu <= 0_ip ) then ! a is lower triangular. check that diagonal is nonzero and ! divide each column by its diagonal. do i = 1_ip , nrowm1 pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do end do return end if ! a is not just a triangular matrix. construct lu factorization do i = 1_ip , nrowm1 ! w(middle,i) is pivot for i-th step . pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if ! jmax is the number of (nonzero) entries in column i ! below the diagonal. jmax = min ( nbandl , nrow - i ) ! divide each entry in column i below diagonal by pivot. do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do ! kmax is the number of (nonzero) entries in row i to ! the right of the diagonal. kmax = min ( nbandu , nrow - i ) ! subtract a(i,i+k)*(i-th column) from (i+k)-th column ! (below row i). do k = 1_ip , kmax ipk = i + k midmk = middle - k factor = w ( midmk , ipk ) do j = 1_ip , jmax w ( midmk + j , ipk ) = w ( midmk + j , ipk ) - w ( middle + j , i ) * factor end do end do end do ! check the last diagonal entry. if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip end subroutine dbnfac !***************************************************************************************** !***************************************************************************************** !> ! Companion routine to [[dbnfac]]. it returns the solution x of the ! linear system a*x = b in place of b, given the lu-factorization ! for a in the work array w from dbnfac. ! ! (with a = l*u , as stored in w), the unit lower triangular system ! l(u*x) = b is solved for y = u*x , and y stored in b. then the ! upper triangular system u*x = y is solved for x. the calculations ! are so arranged that the innermost loops stay within columns. ! !### History ! * banslv written by carl de boor [5] ! * dbnslv from SLATEC library [1] ! * Jacob Williams, 5/10/2015 : converted to free-form Fortran. pure subroutine dbnslv ( w , nroww , nrow , nbandl , nbandu , b ) integer ( ip ), intent ( in ) :: nroww !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nrow !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandl !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandu !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. real ( wp ), dimension ( nroww , nrow ), intent ( in ) :: w !! describes the lu-factorization of a banded matrix a of !! order `nrow` as constructed in [[dbnfac]]. real ( wp ), dimension ( nrow ), intent ( inout ) :: b !! * **in**: right side of the system to be solved !! * **out**: the solution x, of order nrow integer ( ip ) :: i , j , jmax , middle , nrowm1 middle = nbandu + 1_ip if ( nrow /= 1_ip ) then nrowm1 = nrow - 1_ip if ( nbandl /= 0_ip ) then ! forward pass ! for i=1,2,...,nrow-1, subtract right side(i)*(i-th column of l) ! from right side (below i-th row). do i = 1_ip , nrowm1 jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax b ( i + j ) = b ( i + j ) - b ( i ) * w ( middle + j , i ) end do end do end if ! backward pass ! for i=nrow,nrow-1,...,1, divide right side(i) by i-th diagonal ! entry of u, then subtract right side(i)*(i-th column ! of u) from right side (above i-th row). if ( nbandu <= 0_ip ) then ! a is lower triangular. do i = 1_ip , nrow b ( i ) = b ( i ) / w ( 1_ip , i ) end do return end if i = nrow do b ( i ) = b ( i ) / w ( middle , i ) jmax = min ( nbandu , i - 1_ip ) do j = 1_ip , jmax b ( i - j ) = b ( i - j ) - b ( i ) * w ( middle - j , i ) end do i = i - 1_ip if ( i <= 1_ip ) exit end do end if b ( 1_ip ) = b ( 1_ip ) / w ( middle , 1_ip ) end subroutine dbnslv !***************************************************************************************** !***************************************************************************************** !> ! Calculates the value of all (possibly) nonzero basis ! functions at x of order max(jhigh,(j+1)*(index-1)), where t(k) ! <= x <= t(n+1) and j=iwork is set inside the routine on ! the first call when index=1. ileft is such that t(ileft) <= ! x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag) ! produces the proper ileft. dbspvn calculates using the basic ! algorithm needed in dbspvd. if only basis functions are ! desired, setting jhigh=k and index=1 can be faster than ! calling dbspvd, but extra coding is required for derivatives ! (index=2) and dbspvd is set up for this purpose. ! ! left limiting values are set up as described in dbspvd. ! !### Error Conditions ! ! * improper input ! !### History ! * bsplvn written by carl de boor [5] ! * dbspvn author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * 000330 modified array declarations. (jec) ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine dbspvn ( t , jhigh , k , index , x , ileft , vnikx , work , iwork , iflag ) implicit none real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-`k` !! dimension `t(ileft+jhigh)` integer ( ip ), intent ( in ) :: jhigh !! order of b-spline, `1 <= jhigh <= k` integer ( ip ), intent ( in ) :: k !! highest possible order integer ( ip ), intent ( in ) :: index !! index = 1 gives basis functions of order `jhigh` !! = 2 denotes previous entry with `work`, `iwork` !! values saved for subsequent calls to !! dbspvn. real ( wp ), intent ( in ) :: x !! argument of basis functions, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that `t(ileft) <= x < t(ileft+1)` real ( wp ), dimension ( k ), intent ( out ) :: vnikx !! vector of length `k` for spline values. real ( wp ), dimension ( * ), intent ( inout ) :: work !! a work vector of length `2*k` integer ( ip ), intent ( inout ) :: iwork !! a work parameter. both `work` and `iwork` contain !! information necessary to continue for `index = 2`. !! when `index = 1` exclusively, these are scratch !! variables and can be used for other purposes. integer ( ip ), intent ( out ) :: iflag !! * 0: no errors !! * 201: `k` does not satisfy `k>=1` !! * 202: `jhigh` does not satisfy `1<=jhigh<=k` !! * 203: `index` is not 1 or 2 !! * 204: `x` does not satisfy `t(ileft)<=x<=t(ileft+1)` integer ( ip ) :: imjp1 , ipj , jp1 , jp1ml , l real ( wp ) :: vm , vmprev ! content of j, deltam, deltap is expected unchanged between calls. ! work(i) = deltap(i), ! work(k+i) = deltam(i), i = 1,k if ( k < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - k does not satisfy k>=1' iflag = 201_ip return end if if ( jhigh > k . or . jhigh < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - jhigh does not satisfy 1<=jhigh<=k' iflag = 202_ip return end if if ( index < 1_ip . or . index > 2_ip ) then !write(error_unit,'(A)') 'dbspvn - index is not 1 or 2' iflag = 203_ip return end if if ( x < t ( ileft ) . or . x > t ( ileft + 1_ip )) then !write(error_unit,'(A)') 'dbspvn - x does not satisfy t(ileft)<=x<=t(ileft+1)' iflag = 204_ip return end if iflag = 0_ip if ( index == 1_ip ) then iwork = 1_ip vnikx ( 1_ip ) = 1.0_wp if ( iwork >= jhigh ) return end if do ipj = ileft + iwork work ( iwork ) = t ( ipj ) - x imjp1 = ileft - iwork + 1_ip work ( k + iwork ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = iwork + 1_ip do l = 1_ip , iwork jp1ml = jp1 - l vm = vnikx ( l ) / ( work ( l ) + work ( k + jp1ml )) vnikx ( l ) = vm * work ( l ) + vmprev vmprev = vm * work ( k + jp1ml ) end do vnikx ( jp1 ) = vmprev iwork = jp1 if ( iwork >= jhigh ) exit end do end subroutine dbspvn !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the b-representation (`t`,`a`,`n`,`k`) of a b-spline ! at `x` for the function value on `ideriv=0` or any of its ! derivatives on `ideriv=1,2,...,k-1`. right limiting values ! (right derivatives) are returned except at the right end ! point `x=t(n+1)` where left limiting values are computed. the ! spline is defined on `t(k)` \\le `x` \\le `t(n+1)`. ! dbvalu returns a fatal error message when `x` is outside of this ! interval. ! ! To compute left derivatives or left limiting values at a ! knot `t(i)`, replace `n` by `i-1` and set `x=t(i), i=k+1,n+1`. ! !### Error Conditions ! ! * improper input ! !### History ! * bvalue written by carl de boor [5] ! * dbvalu author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * 000330 modified array declarations. (jec) ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine dbvalu ( t , a , n , k , ideriv , x , inbv , work , iflag , val , extrap ) implicit none real ( wp ), intent ( out ) :: val !! the interpolated value integer ( ip ), intent ( in ) :: n !! number of b-spline coefficients. !! (sum of knot multiplicities-`k`) real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k` real ( wp ), dimension ( n ), intent ( in ) :: a !! b-spline coefficient vector of length `n` integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: ideriv !! order of the derivative, `0 <= ideriv <= k-1`. !! `ideriv = 0` returns the b-spline value real ( wp ), intent ( in ) :: x !! argument, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( inout ) :: inbv !! an initialization parameter which must be set !! to 1 the first time [[dbvalu]] is called. !! `inbv` contains information for efficient processing !! after the initial call and `inbv` must not !! be changed by the user. distinct splines require !! distinct `inbv` parameters. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length at least `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 401: `k` does not satisfy `k` \\ge 1 !! * 402: `n` does not satisfy `n` \\ge `k` !! * 403: `ideriv` does not satisfy 0 \\le `ideriv` < `k` !! * 404: `x` is not greater than or equal to `t(k)` !! * 405: `x` is not less than or equal to `t(n+1)` !! * 406: a left limiting value cannot be obtained at `t(k)` logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: i , iderp1 , ihi , ihmkmj , ilo , imk , imkpj , ipj ,& ip1 , ip1mj , j , jj , j1 , j2 , kmider , kmj , km1 , kpk , mflag real ( wp ) :: fkmj real ( wp ) :: xt logical :: extrapolation_allowed !! if extrapolation is allowed val = 0.0_wp if ( k < 1_ip ) then iflag = 401_ip ! dbvalu - k does not satisfy k>=1 return end if if ( n < k ) then iflag = 402_ip ! dbvalu - n does not satisfy n>=k return end if if ( ideriv < 0_ip . or . ideriv >= k ) then iflag = 403_ip ! dbvalu - ideriv does not satisfy 0<=ideriv t ( n + 1_ip )) then xt = t ( n + 1_ip ) else xt = x end if else xt = x end if kmider = k - ideriv ! find *i* in (k,n) such that t(i) <= x < t(i+1) ! (or, <= t(i+1) if t(i) < t(i+1) = t(n+1)). km1 = k - 1_ip call dintrv ( t , n + 1 , xt , inbv , i , mflag ) if ( xt < t ( k )) then iflag = 404_ip ! dbvalu - x is not greater than or equal to t(k) return end if if ( mflag /= 0_ip ) then if ( xt > t ( i )) then iflag = 405_ip ! dbvalu - x is not less than or equal to t(n+1) return end if do if ( i == k ) then iflag = 406_ip ! dbvalu - a left limiting value cannot be obtained at t(k) return end if i = i - 1_ip if ( xt /= t ( i )) exit end do end if ! difference the coefficients *ideriv* times ! work(i) = aj(i), work(k+i) = dp(i), work(k+k+i) = dm(i), i=1.k imk = i - k do j = 1_ip , k imkpj = imk + j work ( j ) = a ( imkpj ) end do if ( ideriv /= 0_ip ) then do j = 1_ip , ideriv kmj = k - j fkmj = real ( kmj , wp ) do jj = 1_ip , kmj ihi = i + jj ihmkmj = ihi - kmj work ( jj ) = ( work ( jj + 1_ip ) - work ( jj )) / ( t ( ihi ) - t ( ihmkmj )) * fkmj end do end do end if ! compute value at *x* in (t(i),(t(i+1)) of ideriv-th derivative, ! given its relevant b-spline coeff. in aj(1),...,aj(k-ideriv). if ( ideriv /= km1 ) then ip1 = i + 1_ip kpk = k + k j1 = k + 1_ip j2 = kpk + 1_ip do j = 1_ip , kmider ipj = i + j work ( j1 ) = t ( ipj ) - x ip1mj = ip1 - j work ( j2 ) = x - t ( ip1mj ) j1 = j1 + 1_ip j2 = j2 + 1_ip end do iderp1 = ideriv + 1_ip do j = iderp1 , km1 kmj = k - j ilo = kmj do jj = 1_ip , kmj work ( jj ) = ( work ( jj + 1_ip ) * work ( kpk + ilo ) + work ( jj ) * & work ( k + jj )) / ( work ( kpk + ilo ) + work ( k + jj )) ilo = ilo - 1 end do end do end if iflag = 0_ip val = work ( 1_ip ) end subroutine dbvalu !***************************************************************************************** !***************************************************************************************** !> ! Computes the largest integer `ileft` in 1 \\le `ileft` \\le `lxt` ! such that `xt(ileft)` \\le `x` where `xt(*)` is a subdivision of ! the `x` interval. ! precisely, ! !```fortran ! if x < xt(1) then ileft=1, mflag=-1 ! if xt(i) <= x < xt(i+1) then ileft=i, mflag=0 ! if xt(lxt) <= x then ileft=lxt, mflag=-2 !``` ! ! that is, when multiplicities are present in the break point ! to the left of `x`, the largest index is taken for `ileft`. ! !### History ! * interv written by carl de boor [5] ! * dintrv author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * Jacob Williams, 2/24/2015 : updated to free-form Fortran. ! * Jacob Williams, 2/17/2016 : additional refactoring (eliminated GOTOs). ! * Jacob Williams, 3/4/2017 : added extrapolation option. pure subroutine dintrv ( xt , lxt , xx , ilo , ileft , mflag , extrap ) implicit none integer ( ip ), intent ( in ) :: lxt !! length of the `xt` vector real ( wp ), dimension (:), intent ( in ) :: xt !! a knot or break point vector of length `lxt` real ( wp ), intent ( in ) :: xx !! argument integer ( ip ), intent ( inout ) :: ilo !! an initialization parameter which must be set !! to 1 the first time the spline array `xt` is !! processed by dintrv. `ilo` contains information for !! efficient processing after the initial call and `ilo` !! must not be changed by the user. distinct splines !! require distinct `ilo` parameters. integer ( ip ), intent ( out ) :: ileft !! largest integer satisfying `xt(ileft)` \\le `x` integer ( ip ), intent ( out ) :: mflag !! signals when `x` lies out of bounds logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: ihi , istep , middle real ( wp ) :: x x = get_temp_x_for_extrap ( xx , xt ( 1_ip ), xt ( lxt ), extrap ) ihi = ilo + 1_ip if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if if ( lxt <= 1 ) then mflag = - 1_ip ileft = 1_ip return end if ilo = lxt - 1_ip ihi = lxt end if if ( x >= xt ( ihi ) ) then ! now x >= xt(ilo). find upper bound istep = 1_ip do ilo = ihi ihi = ilo + istep if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if ihi = lxt else if ( x >= xt ( ihi ) ) then istep = istep * 2_ip cycle end if exit end do else if ( x >= xt ( ilo ) ) then mflag = 0_ip ileft = ilo return end if ! now x <= xt(ihi). find lower bound istep = 1_ip do ihi = ilo ilo = ihi - istep if ( ilo <= 1_ip ) then ilo = 1_ip if ( x < xt ( 1_ip ) ) then mflag = - 1_ip ileft = 1_ip return end if else if ( x < xt ( ilo ) ) then istep = istep * 2_ip cycle end if exit end do end if ! now xt(ilo) <= x < xt(ihi). narrow the interval do middle = ( ilo + ihi ) / 2_ip if ( middle == ilo ) then mflag = 0_ip ileft = ilo return end if ! note. it is assumed that middle = ilo in case ihi = ilo+1 if ( x < xt ( middle ) ) then ihi = middle else ilo = middle end if end do end subroutine dintrv !***************************************************************************************** !***************************************************************************************** !> ! DBINT4 computes the B representation (`t`,`bcoef`,`n`,`k`) of a ! cubic spline (`k=4`) which interpolates data (`x(i)`,`y(i)`),`i=1,ndata`. ! ! Parameters `ibcl`, `ibcr`, `fbcl`, `fbcr` allow the specification of the spline ! first or second derivative at both `x(1)` and `x(ndata)`. When this data is not specified ! by the problem, it is common practice to use a natural spline by setting second ! derivatives at `x(1)` and `x(ndata)` to zero (`ibcl=ibcr=2`,`fbcl=fbcr=0.0`). ! ! The spline is defined on `t(4) <= x <= t(n+1)` with (ordered) interior knots at ! `x(i)` values where n=ndata+2. The knots `t(1)`,`t(2)`,`t(3)` lie to the left of ! `t(4)=x(1)` and the knots `t(n+2)`, `t(n+3)`, `t(n+4)` lie to the right of `t(n+1)=x(ndata)` ! in increasing order. ! ! * If no extrapolation outside (`x(1)`,`x(ndata)`) is anticipated, the ! knots `t(1)=t(2)=t(3)=t(4)=x(1)` and `t(n+2)=t(n+3)=t(n+4)=t(n+1)=x(ndata)` ! can be specified by `kntopt=1`. ! * `kntopt=2` selects a knot placement for `t(1)`, `t(2)`, `t(3)` to make the ! first 7 knots symmetric about `t(4)=x(1)` and similarly for ! `t(n+2)`, `t(n+3)`, `t(n+4)` about `t(n+1)=x(ndata)`. ! * `kntopt=3` allows the user to make his own selection, in increasing order, ! for `t(1)`, `t(2)`, `t(3)` to the left of `x(1)` and `t(n+2)`, `t(n+3)`, `t(n+4)` to ! the right of x(ndata). ! ! In any case, the interpolation on `t(4) <= x <= t(n+1)` ! by using function [[dbvalu]] is unique for given boundary ! conditions. ! !### Error conditions ! * improper input ! * singular system of equations ! !### See also ! * [[dbintk]] ! !### History ! * Written by D. E. Amos (SNLA), August, 1979. ! * date written 800901 ! * revision date 820801 ! * 000330 Modified array declarations. (JEC) ! * Jacob Williams, 8/30/2018 : refactored to modern Fortran. pure subroutine dbint4 ( x , y , ndata , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , t , bcoef , n , k , w , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `ndata`, distinct !! and in increasing order real ( wp ), dimension (:), intent ( in ) :: y !! y vector of ordinates of length ndata integer ( ip ), intent ( in ) :: ndata !! number of data points, `ndata >= 2` integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(ndata)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(ndata)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(n+1)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(n+1)` !! * `kntopt = 3` sets `t(i)=tleft(i)` and !! `t(n+1+i)=tright(i)`,`i=1,3` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! when `kntopt = 3`: `t(1:3)` in increasing !! order to be supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! when `kntopt = 3`: `t(n+2:n+4)` in increasing !! order to be supplied by the user. real ( wp ), dimension (:), intent ( out ) :: t !! knot array of length `n+4` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `n` integer ( ip ), intent ( out ) :: n !! number of coefficients, `n=ndata+2` integer ( ip ), intent ( out ) :: k !! order of spline, `k=4` real ( wp ), dimension ( 5 , ndata + 2 ), intent ( inout ) :: w !! work array integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 2001: `ndata` is less than 2 !! * 2002: `x` values are not distinct or not ordered !! * 2003: `ibcl` is not 1 or 2 !! * 2004: `ibcr` is not 1 or 2 !! * 2005: `kntopt` is not 1, 2, or 3 !! * 2006: knot input through `tleft`, `tright` is !! not ordered properly !! * 2007: the system of equations is singular integer ( ip ) :: i , ilb , ileft , it , iub , iw , iwp , j , jw , ndm , np , nwrow real ( wp ) :: txn , tx1 , xl real ( wp ), dimension ( 4 , 4 ) :: vnikx real ( wp ), dimension ( 15 ) :: work !! work array for [[dbspvd]] -- length `(k+1)*(k+2)/2` real ( wp ), parameter :: wdtol = epsilon ( 1.0_wp ) !! d1mach(4) real ( wp ), parameter :: tol = sqrt ( wdtol ) if ( ndata < 2_ip ) then iflag = 2001_ip ! ndata is less than 2 return end if ndm = ndata - 1_ip do i = 1_ip , ndm if ( x ( i ) >= x ( i + 1_ip )) then iflag = 2002_ip ! x values are not distinct or not ordered return end if end do if ( ibcl < 1_ip . or . ibcl > 2_ip ) then iflag = 2003_ip ! ibcl is not 1 or 2 return end if if ( ibcr < 1_ip . or . ibcr > 2_ip ) then iflag = 2004_ip ! ibcr is not 1 or 2 return end if if ( kntopt < 1_ip . or . kntopt > 3_ip ) then iflag = 2005_ip ! kntopt is not 1, 2, or 3 return end if iflag = 0_ip k = 4_ip n = ndata + 2_ip np = n + 1_ip do i = 1_ip , ndata t ( i + 3 ) = x ( i ) end do select case ( kntopt ) case ( 1_ip ) ! set up knot array with multiplicity 4 at x(1) and x(ndata) do i = 1 , 3_ip t ( 4 - i ) = x ( 1 ) t ( np + i ) = x ( ndata ) end do case ( 2_ip ) !set up knot array with symmetric placement about end points if ( ndata > 3 ) then tx1 = x ( 1 ) + x ( 1 ) txn = x ( ndata ) + x ( ndata ) do i = 1 , 3 t ( 4 - i ) = tx1 - x ( i + 1 ) t ( np + i ) = txn - x ( ndata - i ) end do else xl = ( x ( ndata ) - x ( 1 )) / 3.0_wp do i = 1 , 3 t ( 4 - i ) = t ( 5 - i ) - xl t ( np + i ) = t ( np + i - 1 ) + xl end do end if case ( 3 ) ! set up knot array less than x(1) and greater than x(ndata) to be ! supplied by user in tleft & tright when kntopt=3 t ( 1 : 3 ) = tleft t ( ndata + 4 : ndata + 6 ) = tright do i = 1 , 3 if (( t ( 4 - i ) > t ( 5 - i )) . or . ( t ( np + i ) < t ( np + i - 1 ))) then iflag = 2006_ip ! knot input through tleft, tright is not ordered properly return end if end do end select w = 0.0_wp ! set up left interpolation point and left boundary condition for ! right limits it = ibcl + 1 call dbspvd ( t , k , it , x ( 1 ), k , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check iw = 0_ip if ( abs ( vnikx ( 3 , 1 )) < tol ) iw = 1_ip do j = 1 , 3 w ( j + 1 , 4 - j ) = vnikx ( 4 - j , it ) w ( j , 4 - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( 1 ) = y ( 1 ) bcoef ( 2 ) = fbcl ! set up interpolation equations for points i=2 to i=ndata-1 ileft = 4_ip if ( ndm >= 2 ) then do i = 2 , ndm ileft = ileft + 1_ip call dbspvd ( t , k , 1_ip , x ( i ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check do j = 1 , 3 w ( j + 1 , 3 + i - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( i + 1 ) = y ( i ) end do end if ! set up right interpolation point and right boundary condition for ! left limits(ileft is associated with t(n)=x(ndata-1)) it = ibcr + 1_ip call dbspvd ( t , k , it , x ( ndata ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check jw = 0_ip if ( abs ( vnikx ( 2 , 1 )) < tol ) jw = 1_ip do j = 1 , 3 w ( j + 1 , 3 + ndata - j ) = vnikx ( 5 - j , it ) w ( j + 2 , 3 + ndata - j ) = vnikx ( 5 - j , 1 ) end do bcoef ( n - 1 ) = fbcr bcoef ( n ) = y ( ndata ) ! solve system of equations ilb = 2_ip - jw iub = 2_ip - iw nwrow = 5_ip iwp = iw + 1_ip call dbnfac ( w ( iwp , 1 ), nwrow , n , ilb , iub , iflag ) if ( iflag == 2_ip ) then iflag = 2007_ip ! the system of equations is singular else iflag = 0_ip ! success call dbnslv ( w ( iwp , 1 ), nwrow , n , ilb , iub , bcoef ) end if end subroutine dbint4 !***************************************************************************************** !***************************************************************************************** !> ! DBSPVD calculates the value and all derivatives of order ! less than `nderiv` of all basis functions which do not ! (possibly) vanish at `x`. `ileft` is input such that ! `t(ileft) <= x < t(ileft+1)`. A call to [[dintrv]](`t`,`n+1`,`x`, ! `ilo`,`ileft`,`mflag`) will produce the proper `ileft`. The output of ! dbspvd is a matrix `vnikx(i,j)` of dimension at least `(k,nderiv)` ! whose columns contain the `k` nonzero basis functions and ! their `nderiv-1` right derivatives at `x`, `i=1,k, j=1,nderiv`. ! These basis functions have indices `ileft-k+i`, `i=1,k, ! k <= ileft <= n`. The nonzero part of the `i`-th basis ! function lies in `(t(i),t(i+k)), i=1,n)`. ! ! If `x=t(ileft+1)` then `vnikx` contains left limiting values ! (left derivatives) at `t(ileft+1)`. In particular, `ileft = n` ! produces left limiting values at the right end point ! `x=t(n+1)`. To obtain left limiting values at `t(i)`, `i=k+1,n+1`, ! set `x` = next lower distinct knot, call [[dintrv]] to get `ileft`, ! set `x=t(i)`, and then call dbspvd. ! !### History ! * Written by Carl de Boor and modified by D. E. Amos ! * date written 800901 ! * revision date 820801 ! * 000330 Modified array declarations. (JEC) ! * Jacob Williams, 8/30/2018 : refactored to modern Fortran. ! !@note `DBSPVD` is the `BSPLVD` routine of the reference. pure subroutine dbspvd ( t , k , nderiv , x , ileft , ldvnik , vnikx , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-k integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: nderiv !! number of derivatives = `nderiv-1`, !! `1 <= nderiv <= k` real ( wp ), intent ( in ) :: x !! argument of basis functions, !! `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that !! `t(ileft) <= x < t(ileft+1)` integer ( ip ), intent ( in ) :: ldvnik !! leading dimension of matrix `vnikx` real ( wp ), dimension ( ldvnik , nderiv ), intent ( out ) :: vnikx !! matrix of dimension at least `(k,nderiv)` !! containing the nonzero basis functions !! at `x` and their derivatives columnwise. real ( wp ), dimension ( * ), intent ( out ) :: work !! a work vector of length `(k+1)*(k+2)/2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 3001: `k` does not satisfy `k>=1` !! * 3002: `nderiv` does not satisfy `1<=nderiv<=k` !! * 3003: `ldvnik` does not satisfy `ldvnik>=k` integer ( ip ) :: i , ideriv , ipkmd , j , jj , jlow , jm , jp1mid , kmd , kp1 , l , ldummy , m , mhigh , iwork real ( wp ) :: factor , fkmd , v ! dimension t(ileft+k), work((k+1)*(k+2)/2) ! a(i,j) = work(i+j*(j+1)/2), i=1,j+1 j=1,k-1 ! a(i,k) = work(i+k*(k-1)/2) i=1.k ! work(1) and work((k+1)*(k+2)/2) are not used. if ( k < 1 ) then iflag = 3001_ip ! k does not satisfy k>=1 return end if if ( nderiv < 1 . or . nderiv > k ) then iflag = 3002_ip ! nderiv does not satisfy 1<=nderiv<=k return end if if ( ldvnik < k ) then iflag = 3003_ip ! ldvnik does not satisfy ldvnik>=k return end if iflag = 0_ip ideriv = nderiv kp1 = k + 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 1_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 . or . ideriv == 1 ) return mhigh = ideriv do m = 2 , mhigh jp1mid = 1 do j = ideriv , k vnikx ( j , ideriv ) = vnikx ( jp1mid , 1 ) jp1mid = jp1mid + 1 end do ideriv = ideriv - 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 2_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 ) return end do jm = kp1 * ( kp1 + 1 ) / 2 do l = 1 , jm work ( l ) = 0.0_wp end do ! a(i,i) = work(i*(i+3)/2) = 1.0 i = 1,k l = 2 j = 0 do i = 1 , k j = j + l work ( j ) = 1.0_wp l = l + 1 end do kmd = k do m = 2 , mhigh kmd = kmd - 1 fkmd = real ( kmd , wp ) i = ileft j = k jj = j * ( j + 1 ) / 2 jm = jj - j do ldummy = 1 , kmd ipkmd = i + kmd factor = fkmd / ( t ( ipkmd ) - t ( i )) do l = 1 , j work ( l + jj ) = ( work ( l + jj ) - work ( l + jm )) * factor end do i = i - 1 j = j - 1 jj = jm jm = jm - j end do do i = 1 , k v = 0.0_wp jlow = max ( i , m ) jj = jlow * ( jlow + 1 ) / 2 do j = jlow , k v = work ( i + jj ) * vnikx ( j , m ) + v jj = jj + j + 1 end do vnikx ( i , m ) = v end do end do end subroutine dbspvd !***************************************************************************************** !***************************************************************************************** !> ! DBSQAD computes the integral on `(x1,x2)` of a `k`-th order ! b-spline using the b-representation `(t,bcoef,n,k)`. orders ! `k` as high as 20 are permitted by applying a 2, 6, or 10 ! point gauss formula on subintervals of `(x1,x2)` which are ! formed by included (distinct) knots. ! ! If orders `k` greater than 20 are needed, use [[dbfqad]] with ! `f(x) = 1`. ! !### Note ! * The maximum number of significant digits obtainable in ! DBSQAD is the smaller of ~300 and the number of digits ! carried in `real(wp)` arithmetic. ! !### References ! * D. E. Amos, \"Quadrature subroutines for splines and ! B-splines\", Report SAND79-1825, Sandia Laboratories, ! December 1979. ! !### History ! * Author: Amos, D. E., (SNLA) ! * 800901 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890531 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900326 Removed duplicate information from DESCRIPTION section. (WRB) ! * 920501 Reformatted the REFERENCES section. (WRB) ! * Jacob Williams, 9/6/2017 : refactored to modern Fortran. ! Added higher precision coefficients. ! !@note Extrapolation is not enabled for this routine. pure subroutine dbsqad ( t , bcoef , n , k , x1 , x2 , bquad , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot array of length `n+k` real ( wp ), dimension (:), intent ( in ) :: bcoef !! b-spline coefficient array of length `n` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `1 <= k <= 20` real ( wp ), intent ( in ) :: x1 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( out ) :: bquad !! integral of the b-spline over (`x1`,`x2`) real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 901: `k` does not satisfy `1<=k<=20` !! * 902: `n` does not satisfy `n>=k` !! * 903: `x1` or `x2` or both do !! not satisfy `t(k)<=x<=t(n+1)` integer ( ip ) :: i , il1 , il2 , ilo , inbv , jf , left , m , mf , mflag , npk , np1 real ( wp ) :: a , aa , b , bb , bma , bpa , c1 , gx , q , ta , tb , y1 , y2 real ( wp ), dimension ( 5 ) :: s !! sum real ( wp ), dimension ( 9 ), parameter :: gpts = [ & & 0.577350269189625764509148780501957455647601751270126876018602326483977 & & 67230293334569371539558574952522520871380513556767665664836499965082627 & & 05518373647912161760310773007685273559916067003615583077550051041144223 & & 01107628883557418222973945990409015710553455953862673016662179126619796 & & 4892168_wp ,& & 0.238619186083196908630501721680711935418610630140021350181395164574274 & & 93427563984224922442725734913160907222309701068720295545303507720513526 & & 28872175189982985139866216812636229030578298770859440976999298617585739 & & 46921613621659222233462641640013936777894532787145324672151888999339900 & & 0945406150514997832_wp ,& & 0.661209386466264513661399595019905347006448564395170070814526705852183 & & 49660714310094428640374646145642988837163927514667955734677222538043817 & & 23198010093367423918538864300079016299442625145884902455718821970386303 & & 22362011735232135702218793618906974301231555871064213101639896769013566 & & 1651261150514997832_wp ,& & 0.932469514203152027812301554493994609134765737712289824872549616526613 & & 50084420019627628873992192598504786367972657283410658797137951163840419 & & 21786180750210169211578452038930846310372961174632524612619760497437974 & & 07422632089671621172178385230505104744277222209386367655366917903888025 & & 2326771150514997832_wp ,& & 0.148874338981631210884826001129719984617564859420691695707989253515903 & & 61735566852137117762979946369123003116080525533882610289018186437654023 & & 16761969968090913050737827720371059070942475859422743249837177174247346 & & 21691485290294292900319346665908243383809435507599683357023000500383728 & & 0634351_wp ,& & 0.433395394129247190799265943165784162200071837656246496502701513143766 & & 98907770350122510275795011772122368293504099893794727422475772324920512 & & 67741032822086200952319270933462032011328320387691584063411149801129823 & & 14148878744320432476641442157678880770848387945248811854979703928792696 & & 4254222_wp ,& & 0.679409568299024406234327365114873575769294711834809467664817188952558 & & 57539507492461507857357048037949983390204739931506083674084257663009076 & & 82741718202923543197852846977409718369143712013552962837733153108679126 & & 93254495485472934132472721168027426848661712101171203022718105101071880 & & 4444161_wp ,& & 0.865063366688984510732096688423493048527543014965330452521959731845374 & & 75513805556135679072894604577069440463108641176516867830016149345356373 & & 92729396890950011571349689893051612072435760480900979725923317923795535 & & 73929059587977695683242770223694276591148364371481692378170157259728913 & & 9322313_wp ,& & 0.973906528517171720077964012084452053428269946692382119231212066696595 & & 20323463615962572356495626855625823304251877421121502216860143447777992 & & 05409587259942436704413695764881258799146633143510758737119877875210567 & & 06745243536871368303386090938831164665358170712568697066873725922944928 & & 4383797_wp ] real ( wp ), dimension ( 9 ), parameter :: gwts = [ & & 1.0_wp ,& & 0.467913934572691047389870343989550994811655605769210535311625319963914 & & 20162039812703111009258479198230476626878975479710092836255417350295459 & & 35635592733866593364825926382559018030281273563502536241704619318259000 & & 99756987095900533474080074634376824431808173206369174103416261765346292 & & 7888917150514997832_wp ,& & 0.360761573048138607569833513837716111661521892746745482289739240237140 & & 03783726171832096220198881934794311720914037079858987989027836432107077 & & 67872114085818922114502722525757771126000732368828591631602895111800517 & & 40813685547074482472486101183259931449817216402425586777526768199930950 & & 3106873150514997832_wp ,& & 0.171324492379170345040296142172732893526822501484043982398635439798945 & & 76054234015464792770542638866975211652206987440430919174716746217597462 & & 96492293180314484520671351091683210843717994067668872126692485569940481 & & 59429327357024984053433824182363244118374610391205239119044219703570297 & & 7497812150514997832_wp ,& & 0.295524224714752870173892994651338329421046717026853601354308029755995 & & 93821715232927035659579375421672271716440125255838681849078955200582600 & & 19363424941869666095627186488841680432313050615358674090830512706638652 & & 87483901746874726597515954450775158914556548308329986393605934912382356 & & 670244_wp ,& & 0.269266719309996355091226921569469352859759938460883795800563276242153 & & 43231917927676422663670925276075559581145036869830869292346938114524155 & & 64658846634423711656014432259960141729044528030344411297902977067142537 & & 53480628460839927657500691168674984281408628886853320804215041950888191 & & 6391898_wp ,& & 0.219086362515982043995534934228163192458771870522677089880956543635199 & & 91065295128124268399317720219278659121687281288763476662690806694756883 & & 09211843316656677105269915322077536772652826671027878246851010208832173 & & 32006427348325475625066841588534942071161341022729156547776892831330068 & & 8702802_wp ,& & 0.149451349150580593145776339657697332402556639669427367835477268753238 & & 65472663001094594726463473195191400575256104543633823445170674549760147 & & 13716011937109528798134828865118770953566439639333773939909201690204649 & & 08381561877915752257830034342778536175692764212879241228297015017259084 & & 2897331_wp ,& & 0.066671344308688137593568809893331792857864834320158145128694881613412 & & 06408408710177678550968505887782109005471452041933148750712625440376213 & & 93049873169940416344953637064001870112423155043935262424506298327181987 & & 18647480566044117862086478449236378557180717569208295026105115288152794 & & 421677_wp ] iflag = 0_ip bquad = 0.0_wp if ( k < 1_ip . or . k > 20_ip ) then iflag = 901_ip ! error return else if ( n < k ) then iflag = 902_ip ! error return else aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ! selection of 2, 6, or 10 point gauss formula jf = 0_ip mf = 1_ip if ( k > 4_ip ) then jf = 1_ip mf = 3_ip if ( k > 12_ip ) then jf = 4_ip mf = 5_ip end if end if do i = 1_ip , mf s ( i ) = 0.0_wp end do ilo = 1_ip inbv = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) bma = 0.5_wp * ( b - a ) bpa = 0.5_wp * ( b + a ) do m = 1_ip , mf c1 = bma * gpts ( jf + m ) gx = - c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y2 ) if ( iflag /= 0_ip ) return gx = c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y1 ) if ( iflag /= 0_ip ) return s ( m ) = s ( m ) + ( y1 + y2 ) * bma end do end if end do q = 0.0_wp do m = 1_ip , mf q = q + gwts ( jf + m ) * s ( m ) end do if ( x1 > x2 ) q = - q bquad = q return end if end if iflag = 903_ip ! error return end if end subroutine dbsqad !***************************************************************************************** !***************************************************************************************** !> ! dbfqad computes the integral on `(x1,x2)` of a product of a ! function `f` and the `id`-th derivative of a `k`-th order b-spline, ! using the b-representation `(t,bcoef,n,k)`. `(x1,x2)` must be a ! subinterval of `t(k) <= x <= t(n+1)`. an integration routine, ! [[dbsgq8]] (a modification of `gaus8`), integrates the product ! on subintervals of `(x1,x2)` formed by included (distinct) knots ! !### Reference ! * D. E. Amos, \"Quadrature subroutines for splines and ! B-splines\", Report SAND79-1825, Sandia Laboratories, ! December 1979. ! !### History ! * 800901 Amos, D. E., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890531 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900326 Removed duplicate information from DESCRIPTION section. (WRB) ! * 920501 Reformatted the REFERENCES section. (WRB) ! * Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes. ! !@note the maximum number of significant digits obtainable in ! [[dbsqad]] is the smaller of ~300 and the number of digits ! carried in `real(wp)` arithmetic. ! !@note Extrapolation is not enabled for this routine. subroutine dbfqad ( f , t , bcoef , n , k , id , x1 , x2 , tol , quad , iflag , work ) implicit none procedure ( b1fqad_func ) :: f !! external function of one argument for the !! integrand `bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work)` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `k >= 1` real ( wp ), dimension ( n + k ), intent ( in ) :: t !! knot array real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! coefficient array integer ( ip ), intent ( in ) :: id !! order of the spline derivative, `0 <= id <= k-1` !! `id=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: quad !! integral of `bf(x)` on `(x1,x2)` real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 1001: `k` does not satisfy `k>=1` !! * 1002: `n` does not satisfy `n>=k` !! * 1003: `d` does not satisfy `0<=id= k ) then iflag = 1003_ip ! error else if ( tol >= min_tol . and . tol <= 0.1_wp ) then aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ilo = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n inbv = 1_ip q = 0.0_wp do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) call dbsgq8 ( f , t , bcoef , n , k , id , a , b , inbv , err , ans , iflag , work ) if ( iflag /= 0_ip . and . iflag /= 1101_ip ) return q = q + ans end if end do if ( x1 > x2 ) q = - q quad = q end if else iflag = 1004_ip ! error end if else iflag = 1005_ip ! error end if end if end subroutine dbfqad !***************************************************************************************** !***************************************************************************************** !> ! DBSGQ8, a modification of [gaus8](http://netlib.sandia.gov/slatec/src/gaus8.f), ! integrates the product of `fun(x)` by the `id`-th derivative of a spline ! [[dbvalu]] between limits `a` and `b` using an adaptive 8-point Legendre-Gauss ! algorithm. ! !### See also ! * [[dbfqad]] ! !### History ! * 800901 Jones, R. E., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890911 Removed unnecessary intrinsics. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900326 Removed duplicate information from DESCRIPTION section. (WRB) ! * 900328 Added TYPE section. (WRB) ! * 910408 Updated the AUTHOR section. (WRB) ! * Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes. ! Added higher precision coefficients. subroutine dbsgq8 ( fun , xt , bc , n , kk , id , a , b , inbv , err , ans , iflag , work ) implicit none procedure ( b1fqad_func ) :: fun !! name of external function of one !! argument which multiplies [[dbvalu]]. integer ( ip ), intent ( in ) :: n !! number of b-coefficients for [[dbvalu]] integer ( ip ), intent ( in ) :: kk !! order of the spline, `kk>=1` real ( wp ), dimension (:), intent ( in ) :: xt !! knot array for [[dbvalu]] real ( wp ), dimension ( n ), intent ( in ) :: bc !! b-coefficient array for [[dbvalu]] integer ( ip ), intent ( in ) :: id !! Order of the spline derivative, `0<=id<=kk-1` real ( wp ), intent ( in ) :: a !! lower limit of integral real ( wp ), intent ( in ) :: b !! upper limit of integral (may be less than `a`) integer ( ip ), intent ( inout ) :: inbv !! initialization parameter for [[dbvalu]] real ( wp ), intent ( inout ) :: err !! **IN:** is a requested pseudorelative error !! tolerance. normally pick a value of !! `abs(err)<1e-3`. `ans` will normally !! have no more error than `abs(err)` times !! the integral of the absolute value of !! `fun(x)*[[dbvalu]]()`. !! !! **OUT:** will be an estimate of the absolute !! error in ans if the input value of `err` !! was negative. (`err` is unchanged if !! the input value of `err` was nonnegative.) !! the estimated error is solely for information !! to the user and should not be used as a !! correction to the computed integral. real ( wp ), intent ( out ) :: ans !! computed value of integral integer ( ip ), intent ( out ) :: iflag !! a status code: !! !! * 0: `ans` most likely meets requested !! error tolerance, or `a=b`. !! * 1101: `a` and `b` are too nearly equal !! to allow normal integration. !! `ans` is set to zero. !! * 1102: `ans` probably does not meet !! requested error tolerance. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` for [[dbvalu]] integer ( ip ) :: k , l , lmn , lmx , mxl , nbits , nib , nlmx real ( wp ) :: ae , anib , area , c , ce , ee , ef , eps , est , gl , glr , tol , vr , x integer ( ip ), dimension ( 60 ) :: lr real ( wp ), dimension ( 60 ) :: aa , hh , vl , gr integer ( ip ), parameter :: i1mach14 = digits ( 1.0_wp ) !! i1mach(14) real ( wp ), parameter :: d1mach5 = log10 ( real ( radix ( x ), wp )) !! d1mach(5) real ( wp ), parameter :: ln2 = log ( 2.0_wp ) !! 0.69314718d0 real ( wp ), parameter :: sq2 = sqrt ( 2.0_wp ) integer ( ip ), parameter :: nlmn = 1 integer ( ip ), parameter :: kmx = 5000 integer ( ip ), parameter :: kml = 6 ! initialize inbv = 1_ip iflag = 0_ip k = i1mach14 anib = d1mach5 * k / 0.30102000_wp nbits = int ( anib , ip ) nlmx = min (( nbits * 5_ip ) / 8_ip , 60_ip ) ans = 0.0_wp ce = 0.0_wp if ( a == b ) then if ( err < 0.0_wp ) err = ce else lmx = nlmx lmn = nlmn if ( b /= 0.0_wp ) then if ( sign ( 1.0_wp , b ) * a > 0.0_wp ) then c = abs ( 1.0_wp - a / b ) if ( c <= 0.1_wp ) then if ( c <= 0.0_wp ) then if ( err < 0.0_wp ) err = ce return else anib = 0.5_wp - log ( c ) / ln2 nib = int ( anib , ip ) lmx = min ( nlmx , nbits - nib - 7_ip ) if ( lmx < 1_ip ) then ! a and b are too nearly equal ! to allow normal integration iflag = 1101_ip if ( err < 0.0_wp ) err = ce return else lmn = min ( lmn , lmx ) end if end if end if end if end if tol = max ( abs ( err ), 2.0_wp ** ( 5 - nbits )) / 2.0_wp if ( err == 0.0_wp ) tol = sqrt ( epsilon ( 1.0_wp )) eps = tol hh ( 1_ip ) = ( b - a ) / 4.0_wp aa ( 1_ip ) = a lr ( 1_ip ) = 1_ip l = 1_ip call g8 ( aa ( l ) + 2.0_wp * hh ( l ), 2.0_wp * hh ( l ), est , iflag ) if ( iflag /= 0_ip ) return k = 8_ip area = abs ( est ) ef = 0.5_wp mxl = 0_ip end if do ! compute refined estimates, estimate the error, etc. call g8 ( aa ( l ) + hh ( l ), hh ( l ), gl , iflag ) if ( iflag /= 0_ip ) return call g8 ( aa ( l ) + 3.0_wp * hh ( l ), hh ( l ), gr ( l ), iflag ) if ( iflag /= 0_ip ) return k = k + 16_ip area = area + ( abs ( gl ) + abs ( gr ( l )) - abs ( est )) glr = gl + gr ( l ) ee = abs ( est - glr ) * ef ae = max ( eps * area , tol * abs ( glr )) if ( ee > ae ) then ! consider the left half of this level if ( k > kmx ) lmx = kml if ( l >= lmx ) then mxl = 1_ip else l = l + 1_ip eps = eps * 0.5_wp ef = ef / sq2 hh ( l ) = hh ( l - 1 ) * 0.5_wp lr ( l ) = - 1_ip aa ( l ) = aa ( l - 1_ip ) est = gl cycle end if end if ce = ce + ( est - glr ) if ( lr ( l ) <= 0_ip ) then ! proceed to right half at this level vl ( l ) = glr else ! return one level vr = glr do if ( l <= 1_ip ) then ! exit ans = vr if ( ( mxl /= 0_ip ) . and . ( abs ( ce ) > 2.0_wp * tol * area ) ) then iflag = 1102_ip end if if ( err < 0.0_wp ) err = ce return else l = l - 1_ip eps = eps * 2.0_wp ef = ef * sq2 if ( lr ( l ) <= 0 ) then vl ( l ) = vl ( l + 1_ip ) + vr exit else vr = vl ( l + 1_ip ) + vr end if end if end do end if est = gr ( l - 1_ip ) lr ( l ) = 1_ip aa ( l ) = aa ( l ) + 4.0_wp * hh ( l ) end do contains subroutine g8 ( x , h , res , iflag ) !! 8-point formula. !! !!@note Replaced the original double precision abscissa and weight !! coefficients with the higher precision versions from here: !! http://pomax.github.io/bezierinfo/legendre-gauss.html !! So, if `wp` is changed to say, `real128`, more precision !! can be obtained. These coefficients have about 300 digits. implicit none real ( wp ), intent ( in ) :: x real ( wp ), intent ( in ) :: h real ( wp ), intent ( out ) :: res integer ( ip ), intent ( out ) :: iflag real ( wp ), dimension ( 8 ) :: f real ( wp ), dimension ( 8 ) :: v ! abscissa and weight coefficients: real ( wp ), parameter :: x1 = & & 0.1834346424956498049394761423601839806667578129129737823171884736992044 & & 742215421141160682237111233537452676587642867666089196012523876865683788 & & 569995160663568104475551617138501966385810764205532370882654749492812314 & & 961247764619363562770645716456613159405134052985058171969174306064445289 & & 638150514997832_wp real ( wp ), parameter :: x2 = & & 0.5255324099163289858177390491892463490419642431203928577508570992724548 & & 207685612725239614001936319820619096829248252608507108793766638779939805 & & 395303668253631119018273032402360060717470006127901479587576756241288895 & & 336619643528330825624263470540184224603688817537938539658502113876953598 & & 879150514997832_wp real ( wp ), parameter :: x3 = & & 0.7966664774136267395915539364758304368371717316159648320701702950392173 & & 056764730921471519272957259390191974534530973092653656494917010859602772 & & 562074621689676153935016290342325645582634205301545856060095727342603557 & & 415761265140428851957341933710803722783136113628137267630651413319993338 & & 002150514997832_wp real ( wp ), parameter :: x4 = & & 0.9602898564975362316835608685694729904282352343014520382716397773724248 & & 977434192844394389592633122683104243928172941762102389581552171285479373 & & 642204909699700433982618326637346808781263553346927867359663480870597542 & & 547603929318533866568132868842613474896289232087639988952409772489387324 & & 25615051499783203_wp real ( wp ), parameter :: w1 = & & 0.3626837833783619829651504492771956121941460398943305405248230675666867 & & 347239066773243660420848285095502587699262967065529258215569895173844995 & & 576007862076842778350382862546305771007553373269714714894268328780431822 & & 779077846722965535548199601402487767505928976560993309027632737537826127 & & 502150514997832_wp real ( wp ), parameter :: w2 = & & 0.3137066458778872873379622019866013132603289990027349376902639450749562 & & 719421734969616980762339285560494275746410778086162472468322655616056890 & & 624276469758994622503118776562559463287222021520431626467794721603822601 & & 295276898652509723185157998353156062419751736972560423953923732838789657 & & 919150514997832_wp real ( wp ), parameter :: w3 = & & 0.2223810344533744705443559944262408844301308700512495647259092892936168 & & 145704490408536531423771979278421592661012122181231114375798525722419381 & & 826674532090577908613289536840402789398648876004385697202157482063253247 & & 195590228631570651319965589733545440605952819880671616779621183704306688 & & 233150514997832_wp real ( wp ), parameter :: w4 = & & 0.1012285362903762591525313543099621901153940910516849570590036980647401 & & 787634707848602827393040450065581543893314132667077154940308923487678731 & & 973041136073584690533208824050731976306575729205467961435779467552492328 & & 730055025992954089946676810510810729468366466585774650346143712142008566 & & 866150514997832_wp res = 0.0_wp v ( 1_ip ) = x - x1 * h v ( 2_ip ) = x + x1 * h v ( 3_ip ) = x - x2 * h v ( 4_ip ) = x + x2 * h v ( 5_ip ) = x - x3 * h v ( 6_ip ) = x + x3 * h v ( 7_ip ) = x - x4 * h v ( 8_ip ) = x + x4 * h call dbvalu ( xt , bc , n , kk , id , v ( 1_ip ), inbv , work , iflag , f ( 1_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 2_ip ), inbv , work , iflag , f ( 2_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 3_ip ), inbv , work , iflag , f ( 3_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 4_ip ), inbv , work , iflag , f ( 4_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 5_ip ), inbv , work , iflag , f ( 5_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 6_ip ), inbv , work , iflag , f ( 6_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 7_ip ), inbv , work , iflag , f ( 7_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 8_ip ), inbv , work , iflag , f ( 8_ip )); if ( iflag /= 0_ip ) return res = h * (( w1 * ( fun ( v ( 1_ip )) * f ( 1_ip ) + fun ( v ( 2_ip )) * f ( 2_ip )) + & w2 * ( fun ( v ( 3_ip )) * f ( 3_ip ) + fun ( v ( 4_ip )) * f ( 4_ip ))) + & ( w3 * ( fun ( v ( 5_ip )) * f ( 5_ip ) + fun ( v ( 6_ip )) * f ( 6_ip )) + & w4 * ( fun ( v ( 7_ip )) * f ( 7_ip ) + fun ( v ( 8_ip )) * f ( 8_ip )))) end subroutine g8 end subroutine dbsgq8 !***************************************************************************************** !***************************************************************************************** !> ! Returns the value of `x` to use for computing the interval ! in `t`, depending on if extrapolation is allowed or not. ! ! If extrapolation is allowed and x is < tmin or > tmax, then either ! `tmin` or `tmax - 2.0_wp*spacing(tmax)` is returned. ! Otherwise, `x` is returned. pure function get_temp_x_for_extrap ( x , tmin , tmax , extrap ) result ( xt ) implicit none real ( wp ), intent ( in ) :: x !! variable value real ( wp ), intent ( in ) :: tmin !! first knot vector element for b-splines real ( wp ), intent ( in ) :: tmax !! last knot vector element for b-splines real ( wp ) :: xt !! The value returned (it will either !! be `tmin`, `x`, or `tmax`) logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: extrapolation_allowed !! if extrapolation is allowed if ( present ( extrap )) then extrapolation_allowed = extrap else extrapolation_allowed = . false . end if if ( extrapolation_allowed ) then if ( x < tmin ) then xt = tmin else if ( x > tmax ) then ! Put it just inside the upper bound. ! This is sort of a hack to get ! extrapolation to work. xt = tmax - 2.0_wp * spacing ( tmax ) else xt = x end if else xt = x end if end function get_temp_x_for_extrap !***************************************************************************************** !***************************************************************************************** !> ! Returns a message string associated with the status code. pure function get_status_message ( iflag ) result ( msg ) implicit none integer ( ip ), intent ( in ) :: iflag !! return code from one of the routines character ( len = :), allocatable :: msg !! status message associated with the flag character ( len = 10 ) :: istr !! for integer to string conversion integer ( ip ) :: istat !! for write statement select case ( iflag ) case ( 0_ip ); msg = 'Successful execution' case ( - 1_ip ); msg = 'Error in dintrv: x < xt(1_ip)' case ( - 2_ip ); msg = 'Error in dintrv: x >= xt(lxt)' case ( 1_ip ); msg = 'Error in evaluate_*d: class is not initialized' case ( 2_ip ); msg = 'Error in db*ink: iknot out of range' case ( 3_ip ); msg = 'Error in db*ink: nx out of range' case ( 4_ip ); msg = 'Error in db*ink: kx out of range' case ( 5_ip ); msg = 'Error in db*ink: x not strictly increasing' case ( 6_ip ); msg = 'Error in db*ink: tx not non-decreasing' case ( 7_ip ); msg = 'Error in db*ink: ny out of range' case ( 8_ip ); msg = 'Error in db*ink: ky out of range' case ( 9_ip ); msg = 'Error in db*ink: y not strictly increasing' case ( 10_ip ); msg = 'Error in db*ink: ty not non-decreasing' case ( 11_ip ); msg = 'Error in db*ink: nz out of range' case ( 12_ip ); msg = 'Error in db*ink: kz out of range' case ( 13_ip ); msg = 'Error in db*ink: z not strictly increasing' case ( 14_ip ); msg = 'Error in db*ink: tz not non-decreasing' case ( 15_ip ); msg = 'Error in db*ink: nq out of range' case ( 16_ip ); msg = 'Error in db*ink: kq out of range' case ( 17_ip ); msg = 'Error in db*ink: q not strictly increasing' case ( 18_ip ); msg = 'Error in db*ink: tq not non-decreasing' case ( 19_ip ); msg = 'Error in db*ink: nr out of range' case ( 20_ip ); msg = 'Error in db*ink: kr out of range' case ( 21_ip ); msg = 'Error in db*ink: r not strictly increasing' case ( 22_ip ); msg = 'Error in db*ink: tr not non-decreasing' case ( 23_ip ); msg = 'Error in db*ink: ns out of range' case ( 24_ip ); msg = 'Error in db*ink: ks out of range' case ( 25_ip ); msg = 'Error in db*ink: s not strictly increasing' case ( 26_ip ); msg = 'Error in db*ink: ts not non-decreasing' case ( 700_ip ); msg = 'Error in db*ink: size(x) /= size(fcn,1)' case ( 701_ip ); msg = 'Error in db*ink: size(y) /= size(fcn,2)' case ( 702_ip ); msg = 'Error in db*ink: size(z) /= size(fcn,3)' case ( 703_ip ); msg = 'Error in db*ink: size(q) /= size(fcn,4)' case ( 704_ip ); msg = 'Error in db*ink: size(r) /= size(fcn,5)' case ( 705_ip ); msg = 'Error in db*ink: size(s) /= size(fcn,6)' case ( 706_ip ); msg = 'Error in db*ink: size(x) /= nx' case ( 707_ip ); msg = 'Error in db*ink: size(y) /= ny' case ( 708_ip ); msg = 'Error in db*ink: size(z) /= nz' case ( 709_ip ); msg = 'Error in db*ink: size(q) /= nq' case ( 710_ip ); msg = 'Error in db*ink: size(r) /= nr' case ( 711_ip ); msg = 'Error in db*ink: size(s) /= ns' case ( 712_ip ); msg = 'Error in db*ink: size(tx) /= nx+kx' case ( 713_ip ); msg = 'Error in db*ink: size(ty) /= ny+ky' case ( 714_ip ); msg = 'Error in db*ink: size(tz) /= nz+kz' case ( 715_ip ); msg = 'Error in db*ink: size(tq) /= nq+kq' case ( 716_ip ); msg = 'Error in db*ink: size(tr) /= nr+kr' case ( 717_ip ); msg = 'Error in db*ink: size(ts) /= ns+ks' case ( 800_ip ); msg = 'Error in db*ink: size(x) /= size(bcoef,1)' case ( 801_ip ); msg = 'Error in db*ink: size(y) /= size(bcoef,2)' case ( 802_ip ); msg = 'Error in db*ink: size(z) /= size(bcoef,3)' case ( 803_ip ); msg = 'Error in db*ink: size(q) /= size(bcoef,4)' case ( 804_ip ); msg = 'Error in db*ink: size(r) /= size(bcoef,5)' case ( 805_ip ); msg = 'Error in db*ink: size(s) /= size(bcoef,6)' case ( 806_ip ); msg = 'Error in dbint4: currently, only k=4 can be used' case ( 100_ip ); msg = 'Error in dbintk: k does not satisfy k>=1' case ( 101_ip ); msg = 'Error in dbintk: n does not satisfy n>=k' case ( 102_ip ); msg = 'Error in dbintk: x(i) does not satisfy x(i)sourcefile~bspline_kinds_module.f90 sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! !### Description ! Numeric kind definitions for BSpline-Fortran. module bspline_kinds_module use , intrinsic :: iso_fortran_env implicit none private #ifdef REAL32 integer , parameter , public :: wp = real32 !! Real working precision [4 bytes] #elif REAL64 integer , parameter , public :: wp = real64 !! Real working precision [8 bytes] #elif REAL128 integer , parameter , public :: wp = real128 !! Real working precision [16 bytes] #else integer , parameter , public :: wp = real64 !! Real working precision if not specified [8 bytes] #endif #ifdef INT8 integer , parameter , public :: ip = int8 !! Integer working precision [1 byte] #elif INT16 integer , parameter , public :: ip = int16 !! Integer working precision [2 bytes] #elif INT32 integer , parameter , public :: ip = int32 !! Integer working precision [4 bytes] #elif INT64 integer , parameter , public :: ip = int64 !! Integer working precision [8 bytes] #else integer , parameter , public :: ip = int32 !! Integer working precision if not specified [4 bytes] #endif !***************************************************************************************** end module bspline_kinds_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_kinds_module.f90.html"},{"title":"bspline_blas_module.F90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_blas_module.f90~~EfferentGraph sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_blas_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_blas_module.f90~~AfferentGraph sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! BLAS procedures, which can be use used if not linking with a BLAS library, ! if one is not available, or if a real kind /= `real64` is required. ! ! The original code has been slightly modernized. ! !### Notes !``` ! reference blas level1 routines ! reference blas is a software package provided by univ. of tennessee, ! univ. of california berkeley, univ. of colorado denver and nag ltd. !``` ! !### See also ! * [BLAS Sourcecode](https://github.com/Reference-LAPACK/lapack/tree/master/BLAS/SRC) module bspline_blas_module #ifndef HAS_BLAS use bspline_kinds_module , only : wp , ip implicit none private public :: daxpy , dcopy , dscal , dswap , ddot , dnrm2 , dasum , idamax , drotm , drotmg contains subroutine daxpy ( n , da , dx , incx , dy , incy ) !! DAXPY constant times a vector plus a vector. !! uses unrolled loops for increments equal to one. real ( wp ) :: da integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( da == 0.0_wp ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 4_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dy ( i ) + da * dx ( i ) end do end if if ( n < 4_ip ) return mp1 = m + 1_ip do i = mp1 , n , 4_ip dy ( i ) = dy ( i ) + da * dx ( i ) dy ( i + 1_ip ) = dy ( i + 1_ip ) + da * dx ( i + 1_ip ) dy ( i + 2_ip ) = dy ( i + 2_ip ) + da * dx ( i + 2_ip ) dy ( i + 3_ip ) = dy ( i + 3_ip ) + da * dx ( i + 3_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dy ( iy ) + da * dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine daxpy subroutine dcopy ( n , dx , incx , dy , incy ) !! DCOPY copies a vector, x, to a vector, y. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 7_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dx ( i ) end do if ( n < 7_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 7_ip dy ( i ) = dx ( i ) dy ( i + 1_ip ) = dx ( i + 1_ip ) dy ( i + 2_ip ) = dx ( i + 2_ip ) dy ( i + 3_ip ) = dx ( i + 3_ip ) dy ( i + 4_ip ) = dx ( i + 4_ip ) dy ( i + 5_ip ) = dx ( i + 5_ip ) dy ( i + 6_ip ) = dx ( i + 6_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine dcopy subroutine dscal ( n , da , dx , incx ) !! DSCAL scales a vector by a constant. !! uses unrolled loops for increment equal to 1. real ( wp ) :: da integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) integer i , m , mp1 , nincx if ( n <= 0_ip . or . incx <= 0_ip ) return if ( incx == 1_ip ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dx ( i ) = da * dx ( i ) end do if ( n < 5_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dx ( i ) = da * dx ( i ) dx ( i + 1_ip ) = da * dx ( i + 1_ip ) dx ( i + 2_ip ) = da * dx ( i + 2_ip ) dx ( i + 3_ip ) = da * dx ( i + 3_ip ) dx ( i + 4_ip ) = da * dx ( i + 4_ip ) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1_ip , nincx , incx dx ( i ) = da * dx ( i ) end do end if end subroutine dscal subroutine dswap ( n , dx , incx , dy , incy ) !! DSWAP interchanges two vectors. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 3_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp end do if ( n < 3_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 3_ip dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp dtemp = dx ( i + 1_ip ) dx ( i + 1_ip ) = dy ( i + 1_ip ) dy ( i + 1_ip ) = dtemp dtemp = dx ( i + 2_ip ) dx ( i + 2_ip ) = dy ( i + 2_ip ) dy ( i + 2_ip ) = dtemp end do else ! code for unequal increments or equal increments not equal ! to 1 ix = 1 iy = 1 if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dx ( ix ) dx ( ix ) = dy ( iy ) dy ( iy ) = dtemp ix = ix + incx iy = iy + incy end do end if end subroutine dswap real ( wp ) function ddot ( n , dx , incx , dy , incy ) !! ddot forms the dot product of two vectors. !! uses unrolled loops for increments equal to one. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 ddot = 0.0_wp dtemp = 0.0_wp if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dtemp + dx ( i ) * dy ( i ) end do if ( n < 5_ip ) then ddot = dtemp return end if end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dtemp = dtemp + dx ( i ) * dy ( i ) + & dx ( i + 1_ip ) * dy ( i + 1_ip ) + dx ( i + 2_ip ) * dy ( i + 2_ip ) + & dx ( i + 3_ip ) * dy ( i + 3_ip ) + dx ( i + 4_ip ) * dy ( i + 4_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dtemp + dx ( ix ) * dy ( iy ) ix = ix + incx iy = iy + incy end do end if ddot = dtemp end function ddot function dnrm2 ( n , x , incx ) !! returns the euclidean norm of a vector real ( wp ) :: dnrm2 real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: maxN = huge ( 0.0_wp ) real ( wp ), parameter :: tsml = real ( radix ( 0._wp ), wp ) ** ceiling ( & ( minexponent ( 0._wp ) - 1 ) * 0.5_wp ) real ( wp ), parameter :: tbig = real ( radix ( 0._wp ), wp ) ** floor ( & ( maxexponent ( 0._wp ) - digits ( 0._wp ) + 1 ) * 0.5_wp ) real ( wp ), parameter :: ssml = real ( radix ( 0._wp ), wp ) ** ( - floor ( & ( minexponent ( 0._wp ) - digits ( 0._wp )) * 0.5_wp )) real ( wp ), parameter :: sbig = real ( radix ( 0._wp ), wp ) ** ( - ceiling ( & ( maxexponent ( 0._wp ) + digits ( 0._wp ) - 1 ) * 0.5_wp )) integer ( ip ) :: incx , n real ( wp ) :: x ( * ) integer ( ip ) :: i , ix logical :: notbig real ( wp ) :: abig , amed , asml , ax , scl , sumsq , ymax , ymin ! ! Quick return if possible ! DNRM2 = zero if ( n <= 0 ) return ! scl = one sumsq = zero ! ! Compute the sum of squares in 3 accumulators: ! abig -- sums of squares scaled down to avoid overflow ! asml -- sums of squares scaled up to avoid underflow ! amed -- sums of squares that do not require scaling ! The thresholds and multipliers are ! tbig -- values bigger than this are scaled down by sbig ! tsml -- values smaller than this are scaled up by ssml ! notbig = . true . asml = zero amed = zero abig = zero ix = 1 if ( incx < 0 ) ix = 1 - ( n - 1 ) * incx do i = 1 , n ax = abs ( x ( ix )) if ( ax > tbig ) then abig = abig + ( ax * sbig ) ** 2 notbig = . false . else if ( ax < tsml ) then if ( notbig ) asml = asml + ( ax * ssml ) ** 2 else amed = amed + ax ** 2 end if ix = ix + incx end do ! ! Combine abig and amed or amed and asml if more than one ! accumulator was used. ! if ( abig > zero ) then ! ! Combine abig and amed if abig > 0. ! if ( ( amed > zero ) . or . ( amed > maxN ) . or . ( amed /= amed ) ) then abig = abig + ( amed * sbig ) * sbig end if scl = one / sbig sumsq = abig else if ( asml > zero ) then ! ! Combine amed and asml if asml > 0. ! if ( ( amed > zero ) . or . ( amed > maxN ) . or . ( amed /= amed ) ) then amed = sqrt ( amed ) asml = sqrt ( asml ) / ssml if ( asml > amed ) then ymin = amed ymax = asml else ymin = asml ymax = amed end if scl = one sumsq = ymax ** 2 * ( one + ( ymin / ymax ) ** 2 ) else scl = one / ssml sumsq = asml end if else ! ! Otherwise all values are mid-range ! scl = one sumsq = amed end if DNRM2 = scl * sqrt ( sumsq ) return end function real ( wp ) function dasum ( n , dx , incx ) !! dasum takes the sum of the absolute values. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) dtemp integer ( ip ) i , m , mp1 , nincx dasum = 0.0_wp dtemp = 0.0_wp if ( n <= 0 . or . incx <= 0 ) return if ( incx == 1 ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 6 ) if ( m /= 0 ) then do i = 1 , m dtemp = dtemp + abs ( dx ( i )) end do if ( n < 6 ) then dasum = dtemp return end if end if mp1 = m + 1 do i = mp1 , n , 6 dtemp = dtemp + abs ( dx ( i )) + abs ( dx ( i + 1 )) + & abs ( dx ( i + 2 )) + abs ( dx ( i + 3 )) + & abs ( dx ( i + 4 )) + abs ( dx ( i + 5 )) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1 , nincx , incx dtemp = dtemp + abs ( dx ( i )) end do end if dasum = dtemp end function dasum integer function idamax ( n , dx , incx ) !! idamax finds the index of the first element having maximum absolute value. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) :: dmax integer ( ip ) :: i , ix idamax = 0 if ( n < 1 . or . incx <= 0 ) return idamax = 1 if ( n == 1 ) return if ( incx == 1 ) then ! code for increment equal to 1 dmax = abs ( dx ( 1 )) do i = 2 , n if ( abs ( dx ( i )) > dmax ) then idamax = i dmax = abs ( dx ( i )) end if end do else ! code for increment not equal to 1 ix = 1 dmax = abs ( dx ( 1 )) ix = ix + incx do i = 2 , n if ( abs ( dx ( ix )) > dmax ) then idamax = i dmax = abs ( dx ( ix )) end if ix = ix + incx end do end if end function idamax subroutine drotm ( n , dx , incx , dy , incy , dparam ) !! apply the modified givens transformation, H, to the 2 by n matrix integer ( ip ) :: incx , incy , n real ( wp ) :: dparam ( 5 ), dx ( * ), dy ( * ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , w , z integer ( ip ) :: i , kx , ky , nsteps real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: two = 2.0_wp dflag = dparam ( 1 ) if ( n <= 0 . or . ( dflag + two == zero )) return if ( incx == incy . and . incx > 0 ) then nsteps = n * incx if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z * dh12 dy ( i ) = w * dh21 + z * dh22 end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w + z * dh12 dy ( i ) = w * dh21 + z end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z dy ( i ) = - w + dh22 * z end do end if else kx = 1 ky = 1 if ( incx < 0 ) kx = 1 + ( 1 - n ) * incx if ( incy < 0 ) ky = 1 + ( 1 - n ) * incy if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z * dh12 dy ( ky ) = w * dh21 + z * dh22 kx = kx + incx ky = ky + incy end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w + z * dh12 dy ( ky ) = w * dh21 + z kx = kx + incx ky = ky + incy end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z dy ( ky ) = - w + dh22 * z kx = kx + incx ky = ky + incy end do end if end if end subroutine drotm subroutine drotmg ( dd1 , dd2 , dx1 , dy1 , dparam ) !! construct the modified givens transformation matrix H real ( wp ) :: dd1 , dd2 , dx1 , dy1 real ( wp ) :: dparam ( 5 ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , dp1 , dp2 , dq1 , dq2 , dtemp ,& du real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: two = 2.0_wp real ( wp ), parameter :: gam = 409 6.0_wp real ( wp ), parameter :: gamsq = gam * gam !! 16777216.0_wp real ( wp ), parameter :: rgamsq = one / gamsq !! 5.9604645e-8_wp if ( dd1 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else ! case-dd1-nonnegative dp2 = dd2 * dy1 if ( dp2 == zero ) then dflag = - two dparam ( 1 ) = dflag return end if ! regular-case.. dp1 = dd1 * dx1 dq2 = dp2 * dy1 dq1 = dp1 * dx1 if ( abs ( dq1 ) > abs ( dq2 )) then dh21 = - dy1 / dx1 dh12 = dp2 / dp1 du = one - dh12 * dh21 if ( du > zero ) then dflag = zero dd1 = dd1 / du dd2 = dd2 / du dx1 = dx1 * du else ! this code path if here for safety. we do not expect this ! condition to ever hold except in edge cases with rounding ! errors. see doi: 10.1145/355841.355847 dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero end if else if ( dq2 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else dflag = one dh11 = dp1 / dp2 dh22 = dx1 / dy1 du = one + dh11 * dh22 dtemp = dd2 / du dd2 = dd1 / du dd1 = dtemp dx1 = dy1 * du end if end if ! procedure..scale-check if ( dd1 /= zero ) then do while (( dd1 <= rgamsq ) . or . ( dd1 >= gamsq )) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( dd1 <= rgamsq ) then dd1 = dd1 * gam ** 2 dx1 = dx1 / gam dh11 = dh11 / gam dh12 = dh12 / gam else dd1 = dd1 / gam ** 2 dx1 = dx1 * gam dh11 = dh11 * gam dh12 = dh12 * gam end if enddo end if if ( dd2 /= zero ) then do while ( ( abs ( dd2 ) <= rgamsq ) . or . ( abs ( dd2 ) >= gamsq ) ) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( abs ( dd2 ) <= rgamsq ) then dd2 = dd2 * gam ** 2 dh21 = dh21 / gam dh22 = dh22 / gam else dd2 = dd2 / gam ** 2 dh21 = dh21 * gam dh22 = dh22 * gam end if end do end if end if if ( dflag < zero ) then dparam ( 2 ) = dh11 dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 dparam ( 5 ) = dh22 else if ( dflag == zero ) then dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 else dparam ( 2 ) = dh11 dparam ( 5 ) = dh22 end if dparam ( 1 ) = dflag end subroutine drotmg #endif end module bspline_blas_module","tags":"","loc":"sourcefile/bspline_blas_module.f90.html"},{"title":"bspline_oo_module.f90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_oo_module.f90~~EfferentGraph sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_oo_module.f90~~AfferentGraph sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! date: 12/6/2015 ! ! Object-oriented style wrappers to [[bspline_sub_module]]. ! This module provides classes ([[bspline_1d(type)]], [[bspline_2d(type)]], ! [[bspline_3d(type)]], [[bspline_4d(type)]], [[bspline_5d(type)]], and [[bspline_6d(type)]]) ! which can be used instead of the main subroutine interface. module bspline_oo_module use bspline_kinds_module , only : wp , ip use , intrinsic :: iso_fortran_env , only : error_unit use bspline_sub_module implicit none private integer ( ip ), parameter :: int_size = storage_size ( 1_ip , kind = ip ) !! size of a default integer [bits] integer ( ip ), parameter :: logical_size = storage_size (. true ., kind = ip ) !! size of a default logical [bits] integer ( ip ), parameter :: real_size = storage_size ( 1.0_wp , kind = ip ) !! size of a `real(wp)` [bits] type , public , abstract :: bspline_class !! Base class for the b-spline types private integer ( ip ) :: inbvx = 1_ip !! internal variable used by [[dbvalu]] for efficient processing integer ( ip ) :: iflag = 1_ip !! saved `iflag` from the list routine call. logical :: initialized = . false . !! true if the class is initialized and ready to use logical :: extrap = . false . !! if true, then extrapolation is allowed during evaluation contains private procedure , non_overridable :: destroy_base !! destructor for the abstract type procedure , non_overridable :: set_extrap_flag !! internal routine to set the `extrap` flag procedure ( destroy_func ), deferred , public :: destroy !! destructor procedure ( size_func ), deferred , public :: size_of !! size of the structure in bits procedure , public , non_overridable :: status_ok !! returns true if the last `iflag` status code was `=0`. procedure , public , non_overridable :: status_message => get_bspline_status_message !! retrieve the last !! status message procedure , public , non_overridable :: clear_flag => clear_bspline_flag !! to reset the `iflag` saved in the class. end type bspline_class abstract interface pure subroutine destroy_func ( me ) !! interface for bspline destructor routines import :: bspline_class implicit none class ( bspline_class ), intent ( inout ) :: me end subroutine destroy_func pure function size_func ( me ) result ( s ) !! interface for size routines import :: bspline_class , ip implicit none class ( bspline_class ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits end function size_func end interface type , extends ( bspline_class ), public :: bspline_1d !! Class for 1d b-spline interpolation. !! !!@note The 1D class also contains two methods !! for computing definite integrals. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x real ( wp ), dimension (:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db1val] work array of dimension `3*kx` contains private generic , public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots procedure :: initialize_1d_auto_knots procedure :: initialize_1d_specify_knots procedure , public :: evaluate => evaluate_1d procedure , public :: destroy => destroy_1d procedure , public :: size_of => size_1d procedure , public :: integral => integral_1d procedure , public :: fintegral => fintegral_1d final :: finalize_1d end type bspline_1d type , extends ( bspline_class ), public :: bspline_2d !! Class for 2d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y real ( wp ), dimension (:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db2val] work array of dimension `ky` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db2val] work array of dimension `3_ip*max(kx,ky)` contains private generic , public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots procedure :: initialize_2d_auto_knots procedure :: initialize_2d_specify_knots procedure , public :: evaluate => evaluate_2d procedure , public :: destroy => destroy_2d procedure , public :: size_of => size_2d final :: finalize_2d end type bspline_2d type , extends ( bspline_class ), public :: bspline_3d !! Class for 3d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z real ( wp ), dimension (:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:), allocatable :: work_val_1 !! [[db3val] work array of dimension `ky,kz` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db3val] work array of dimension `kz` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db3val] work array of dimension `3_ip*max(kx,ky,kz)` contains private generic , public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots procedure :: initialize_3d_auto_knots procedure :: initialize_3d_specify_knots procedure , public :: evaluate => evaluate_3d procedure , public :: destroy => destroy_3d procedure , public :: size_of => size_3d final :: finalize_3d end type bspline_3d type , extends ( bspline_class ), public :: bspline_4d !! Class for 4d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q real ( wp ), dimension (:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:), allocatable :: work_val_1 !! [[db4val]] work array of dimension `ky,kz,kq` real ( wp ), dimension (:,:), allocatable :: work_val_2 !! [[db4val]] work array of dimension `kz,kq` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db4val]] work array of dimension `kq` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db4val]] work array of dimension `3_ip*max(kx,ky,kz,kq)` contains private generic , public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots procedure :: initialize_4d_auto_knots procedure :: initialize_4d_specify_knots procedure , public :: evaluate => evaluate_4d procedure , public :: destroy => destroy_4d procedure , public :: size_of => size_4d final :: finalize_4d end type bspline_4d type , extends ( bspline_class ), public :: bspline_5d !! Class for 5d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r real ( wp ), dimension (:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:), allocatable :: work_val_1 !! [[db5val]] work array of dimension `ky,kz,kq,kr` real ( wp ), dimension (:,:,:), allocatable :: work_val_2 !! [[db5val]] work array of dimension `kz,kq,kr` real ( wp ), dimension (:,:), allocatable :: work_val_3 !! [[db5val]] work array of dimension `kq,kr` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db5val]] work array of dimension `kr` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db5val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr)` contains private generic , public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots procedure :: initialize_5d_auto_knots procedure :: initialize_5d_specify_knots procedure , public :: evaluate => evaluate_5d procedure , public :: destroy => destroy_5d procedure , public :: size_of => size_5d final :: finalize_5d end type bspline_5d type , extends ( bspline_class ), public :: bspline_6d !! Class for 6d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: ns = 0_ip !! Number of s abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r integer ( ip ) :: ks = 0_ip !! The order of spline pieces in s real ( wp ), dimension (:,:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ts !! The knots in the s direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvs = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilos = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:,:), allocatable :: work_val_1 !! [[db6val]] work array of dimension `ky,kz,kq,kr,ks` real ( wp ), dimension (:,:,:,:), allocatable :: work_val_2 !! [[db6val]] work array of dimension `kz,kq,kr,ks` real ( wp ), dimension (:,:,:), allocatable :: work_val_3 !! [[db6val]] work array of dimension `kq,kr,ks` real ( wp ), dimension (:,:), allocatable :: work_val_4 !! [[db6val]] work array of dimension `kr,ks` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db6val]] work array of dimension `ks` real ( wp ), dimension (:), allocatable :: work_val_6 !! [[db6val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr,ks)` contains private generic , public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots procedure :: initialize_6d_auto_knots procedure :: initialize_6d_specify_knots procedure , public :: evaluate => evaluate_6d procedure , public :: destroy => destroy_6d procedure , public :: size_of => size_6d final :: finalize_6d end type bspline_6d interface bspline_1d !! Constructor for [[bspline_1d(type)]] procedure :: bspline_1d_constructor_empty ,& bspline_1d_constructor_auto_knots ,& bspline_1d_constructor_specify_knots end interface interface bspline_2d !! Constructor for [[bspline_2d(type)]] procedure :: bspline_2d_constructor_empty ,& bspline_2d_constructor_auto_knots ,& bspline_2d_constructor_specify_knots end interface interface bspline_3d !! Constructor for [[bspline_3d(type)]] procedure :: bspline_3d_constructor_empty ,& bspline_3d_constructor_auto_knots ,& bspline_3d_constructor_specify_knots end interface interface bspline_4d !! Constructor for [[bspline_4d(type)]] procedure :: bspline_4d_constructor_empty ,& bspline_4d_constructor_auto_knots ,& bspline_4d_constructor_specify_knots end interface interface bspline_5d !! Constructor for [[bspline_5d(type)]] procedure :: bspline_5d_constructor_empty ,& bspline_5d_constructor_auto_knots ,& bspline_5d_constructor_specify_knots end interface interface bspline_6d !! Constructor for [[bspline_6d(type)]] procedure :: bspline_6d_constructor_empty ,& bspline_6d_constructor_auto_knots ,& bspline_6d_constructor_specify_knots end interface contains !***************************************************************************************** !***************************************************************************************** !> ! This routines returns true if the `iflag` code from the last ! routine called was `=0`. Maybe of the routines have output `iflag` ! variables, so they can be checked explicitly, or this routine ! can be used. ! ! If the class is initialized using a function constructor, then ! this is the only way to know if it was properly initialized, ! since those are pure functions with not output `iflag` arguments. ! ! If `status_ok=.false.`, then the error message can be ! obtained from the [[get_bspline_status_message]] routine. ! ! Note: after an error condition, the [[clear_bspline_flag]] routine ! can be called to reset the `iflag` to 0. elemental function status_ok ( me ) result ( ok ) implicit none class ( bspline_class ), intent ( in ) :: me logical :: ok ok = ( me % iflag == 0_ip ) end function status_ok !***************************************************************************************** !***************************************************************************************** !> ! This sets the `iflag` variable in the class to `0` ! (which indicates that everything is OK). It can be used ! after an error is encountered. elemental subroutine clear_bspline_flag ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % iflag = 0_ip end subroutine clear_bspline_flag !***************************************************************************************** !***************************************************************************************** !> ! Get the status message from a [[bspline_class]] routine call. ! ! If `iflag` is not included, then the one in the class is used (which ! corresponds to the last routine called.) ! Otherwise, it will convert the ! input `iflag` argument into the appropriate message. ! ! This is a wrapper for [[get_status_message]]. pure function get_bspline_status_message ( me , iflag ) result ( msg ) implicit none class ( bspline_class ), intent ( in ) :: me character ( len = :), allocatable :: msg !! status message associated with the flag integer ( ip ), intent ( in ), optional :: iflag !! the corresponding status code if ( present ( iflag )) then msg = get_status_message ( iflag ) else msg = get_status_message ( me % iflag ) end if end function get_bspline_status_message !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_1d]] structure in bits. pure function size_1d ( me ) result ( s ) implicit none class ( bspline_1d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 2_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) end function size_1d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_2d]] structure in bits. pure function size_2d ( me ) result ( s ) implicit none class ( bspline_2d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 6_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) end function size_2d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_3d]] structure in bits. pure function size_3d ( me ) result ( s ) implicit none class ( bspline_3d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 10_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) end function size_3d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_4d]] structure in bits. pure function size_4d ( me ) result ( s ) implicit none class ( bspline_4d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 14_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) end function size_4d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_5d]] structure in bits. pure function size_5d ( me ) result ( s ) implicit none class ( bspline_5d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 18_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) end function size_5d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_6d]] structure in bits. pure function size_6d ( me ) result ( s ) implicit none class ( bspline_6d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 22_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) * & size ( me % bcoef , 6 , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % ts )) s = s + real_size * size ( me % ts , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) * & size ( me % work_val_1 , 5_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) * & size ( me % work_val_2 , 4_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) * & size ( me % work_val_3 , 3_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , 1_ip , kind = ip ) * & size ( me % work_val_4 , 2_ip , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) if ( allocated ( me % work_val_6 )) s = s + real_size * size ( me % work_val_6 , kind = ip ) end function size_6d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for contents of the base [[bspline_class]] class. ! (this routine is called by the extended classes). pure subroutine destroy_base ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % inbvx = 1_ip me % iflag = 1_ip me % initialized = . false . me % extrap = . false . end subroutine destroy_base !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_1d]] class. pure subroutine destroy_1d ( me ) implicit none class ( bspline_1d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % kx = 0_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) end subroutine destroy_1d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_2d]] class. pure subroutine destroy_2d ( me ) implicit none class ( bspline_2d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % kx = 0_ip me % ky = 0_ip me % inbvy = 1_ip me % iloy = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) end subroutine destroy_2d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_3d]] class. pure subroutine destroy_3d ( me ) implicit none class ( bspline_3d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % iloy = 1_ip me % iloz = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) end subroutine destroy_3d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_4d]] class. pure subroutine destroy_4d ( me ) implicit none class ( bspline_4d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) end subroutine destroy_4d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_5d]] class. pure subroutine destroy_5d ( me ) implicit none class ( bspline_5d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) end subroutine destroy_5d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_6d]] class. pure subroutine destroy_6d ( me ) implicit none class ( bspline_6d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % ns = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % ks = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % inbvs = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip me % ilos = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % ts )) deallocate ( me % ts ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) if ( allocated ( me % work_val_6 )) deallocate ( me % work_val_6 ) end subroutine destroy_6d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_1d]] class. Just a wrapper for [[destroy_1d]]. pure elemental subroutine finalize_1d ( me ) type ( bspline_1d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_1d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_2d]] class. Just a wrapper for [[destroy_2d]]. pure elemental subroutine finalize_2d ( me ) type ( bspline_2d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_2d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_3d]] class. Just a wrapper for [[destroy_3d]]. pure elemental subroutine finalize_3d ( me ) type ( bspline_3d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_3d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_4d]] class. Just a wrapper for [[destroy_4d]]. pure elemental subroutine finalize_4d ( me ) type ( bspline_4d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_4d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_5d]] class. Just a wrapper for [[destroy_5d]]. pure elemental subroutine finalize_5d ( me ) type ( bspline_5d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_5d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_6d]] class. Just a wrapper for [[destroy_6d]]. pure elemental subroutine finalize_6d ( me ) type ( bspline_6d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_6d !***************************************************************************************** !***************************************************************************************** !> ! Sets the `extrap` flag in the class. pure subroutine set_extrap_flag ( me , extrap ) implicit none class ( bspline_class ), intent ( inout ) :: me logical , intent ( in ), optional :: extrap !! if not present, then False is used if ( present ( extrap )) then me % extrap = extrap else me % extrap = . false . end if end subroutine set_extrap_flag !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_1d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. pure elemental function bspline_1d_constructor_empty () result ( me ) implicit none type ( bspline_1d ) :: me end function bspline_1d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_1d]] type (auto knots). ! This is a wrapper for [[initialize_1d_auto_knots]]. pure function bspline_1d_constructor_auto_knots ( x , fcn , kx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_auto_knots ( me , x , fcn , kx , me % iflag , extrap ) end function bspline_1d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_1d]] type (user-specified knots). ! This is a wrapper for [[initialize_1d_specify_knots]]. pure function bspline_1d_constructor_specify_knots ( x , fcn , kx , tx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_specify_knots ( me , x , fcn , kx , tx , me % iflag , extrap ) end function bspline_1d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_1d]] type (with automatically-computed knots). ! This is a wrapper for [[db1ink]]. pure subroutine initialize_1d_auto_knots ( me , x , fcn , kx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) iknot = 0_ip !knot sequence chosen by db1ink call db1ink ( x , nx , fcn , kx , iknot , me % tx , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_1d]] type (with user-specified knots). ! This is a wrapper for [[db1ink]]. pure subroutine initialize_1d_specify_knots ( me , x , fcn , kx , tx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx , iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) me % tx = tx call db1ink ( x , nx , fcn , kx , 1_ip , me % tx , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_1d]] interpolate. This is a wrapper for [[db1val]]. pure subroutine evaluate_1d ( me , xval , idx , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1val]]) if ( me % initialized ) then call db1val ( xval , idx , me % tx , me % nx , me % kx , me % bcoef , f , iflag ,& me % inbvx , me % work_val_1 , extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_1d !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_1d]] definite integral. This is a wrapper for [[db1sqad]]. pure subroutine integral_1d ( me , x1 , x2 , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( out ) :: f !! integral of the b-spline over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1sqad ( me % tx , me % bcoef , me % nx , me % kx , x1 , x2 , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine integral_1d !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_1d]] definite integral. This is a wrapper for [[db1fqad]]. subroutine fintegral_1d ( me , fun , idx , x1 , x2 , tol , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv)` integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature real ( wp ), intent ( out ) :: f !! integral of `bf(x)` over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1fqad ( fun , me % tx , me % bcoef , me % nx , me % kx , idx , x1 , x2 , tol , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine fintegral_1d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_2d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_2d_constructor_empty () result ( me ) implicit none type ( bspline_2d ) :: me end function bspline_2d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_2d]] type (auto knots). ! This is a wrapper for [[initialize_2d_auto_knots]]. pure function bspline_2d_constructor_auto_knots ( x , y , fcn , kx , ky , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , me % iflag , extrap ) end function bspline_2d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_2d]] type (user-specified knots). ! This is a wrapper for [[initialize_2d_specify_knots]]. pure function bspline_2d_constructor_specify_knots ( x , y , fcn , kx , ky , tx , ty , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , me % iflag , extrap ) end function bspline_2d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_2d]] type (with automatically-computed knots). ! This is a wrapper for [[db2ink]]. pure subroutine initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) iknot = 0_ip !knot sequence chosen by db2ink call db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , me % tx , me % ty , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_2d]] type (with user-specified knots). ! This is a wrapper for [[db2ink]]. pure subroutine initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) me % tx = tx me % ty = ty call db2ink ( x , nx , y , ny , fcn , kx , ky , 1_ip , me % tx , me % ty , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_2d]] interpolate. This is a wrapper for [[db2val]]. pure subroutine evaluate_2d ( me , xval , yval , idx , idy , f , iflag ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2val]]) if ( me % initialized ) then call db2val ( xval , yval ,& idx , idy ,& me % tx , me % ty ,& me % nx , me % ny ,& me % kx , me % ky ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % iloy ,& me % work_val_1 , me % work_val_2 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_2d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_3d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_3d_constructor_empty () result ( me ) implicit none type ( bspline_3d ) :: me end function bspline_3d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_3d]] type (auto knots). ! This is a wrapper for [[initialize_3d_auto_knots]]. pure function bspline_3d_constructor_auto_knots ( x , y , z , fcn , kx , ky , kz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , me % iflag , extrap ) end function bspline_3d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_3d]] type (user-specified knots). ! This is a wrapper for [[initialize_3d_specify_knots]]. pure function bspline_3d_constructor_specify_knots ( x , y , z , fcn , kx , ky , kz , tx , ty , tz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , me % iflag , extrap ) end function bspline_3d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_3d]] type (with automatically-computed knots). ! This is a wrapper for [[db3ink]]. pure subroutine initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) iknot = 0_ip !knot sequence chosen by db3ink call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& iknot ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_3d]] type (with user-specified knots). ! This is a wrapper for [[db3ink]]. pure subroutine initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) me % tx = tx me % ty = ty me % tz = tz call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& 1_ip ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_3d]] interpolate. This is a wrapper for [[db3val]]. pure subroutine evaluate_3d ( me , xval , yval , zval , idx , idy , idz , f , iflag ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3val]]) if ( me % initialized ) then call db3val ( xval , yval , zval ,& idx , idy , idz ,& me % tx , me % ty , me % tz ,& me % nx , me % ny , me % nz ,& me % kx , me % ky , me % kz ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz ,& me % iloy , me % iloz ,& me % work_val_1 , me % work_val_2 , me % work_val_3 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_3d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_4d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_4d_constructor_empty () result ( me ) implicit none type ( bspline_4d ) :: me end function bspline_4d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_4d]] type (auto knots). ! This is a wrapper for [[initialize_4d_auto_knots]]. pure function bspline_4d_constructor_auto_knots ( x , y , z , q , fcn , kx , ky , kz , kq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , me % iflag , extrap ) end function bspline_4d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_4d]] type (user-specified knots). ! This is a wrapper for [[initialize_4d_specify_knots]]. pure function bspline_4d_constructor_specify_knots ( x , y , z , q , fcn , kx , ky , kz , kq ,& tx , ty , tz , tq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_specify_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , tx , ty , tz , tq , me % iflag , extrap ) end function bspline_4d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_4d]] type (with automatically-computed knots). ! This is a wrapper for [[db4ink]]. pure subroutine initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) iknot = 0_ip !knot sequence chosen by db4ink call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_4d]] type (with user-specified knots). ! This is a wrapper for [[db4ink]]. pure subroutine initialize_4d_specify_knots ( me , x , y , z , q , fcn ,& kx , ky , kz , kq , tx , ty , tz , tq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_4d]] interpolate. This is a wrapper for [[db4val]]. pure subroutine evaluate_4d ( me , xval , yval , zval , qval , idx , idy , idz , idq , f , iflag ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4val]]) if ( me % initialized ) then call db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& me % tx , me % ty , me % tz , me % tq ,& me % nx , me % ny , me % nz , me % nq ,& me % kx , me % ky , me % kz , me % kq ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq ,& me % iloy , me % iloz , me % iloq ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_4d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_5d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_5d_constructor_empty () result ( me ) implicit none type ( bspline_5d ) :: me end function bspline_5d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_5d]] type (auto knots). ! This is a wrapper for [[initialize_5d_auto_knots]]. pure function bspline_5d_constructor_auto_knots ( x , y , z , q , r , fcn , kx , ky , kz , kq , kr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , me % iflag , extrap ) end function bspline_5d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_5d]] type (user-specified knots). ! This is a wrapper for [[initialize_5d_specify_knots]]. pure function bspline_5d_constructor_specify_knots ( x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_specify_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , tx , ty , tz , tq , tr , me % iflag , extrap ) end function bspline_5d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_5d]] type (with automatically-computed knots). ! This is a wrapper for [[db5ink]]. pure subroutine initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) iknot = 0_ip !knot sequence chosen by db5ink call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_5d]] type (with user-specified knots). ! This is a wrapper for [[db5ink]]. pure subroutine initialize_5d_specify_knots ( me , x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_5d]] interpolate. This is a wrapper for [[db5val]]. pure subroutine evaluate_5d ( me , xval , yval , zval , qval , rval , idx , idy , idz , idq , idr , f , iflag ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5val]]) if ( me % initialized ) then call db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % nx , me % ny , me % nz , me % nq , me % nr ,& me % kx , me % ky , me % kz , me % kq , me % kr ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr ,& me % iloy , me % iloz , me % iloq , me % ilor ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_5d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_6d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_6d_constructor_empty () result ( me ) implicit none type ( bspline_6d ) :: me end function bspline_6d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_6d]] type (auto knots). ! This is a wrapper for [[initialize_6d_auto_knots]]. pure function bspline_6d_constructor_auto_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn , kx , ky , kz , kq , kr , ks , me % iflag , extrap ) end function bspline_6d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_6d]] type (user-specified knots). ! This is a wrapper for [[initialize_6d_specify_knots]]. pure function bspline_6d_constructor_specify_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , me % iflag , extrap ) end function bspline_6d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_6d]] type (with automatically-computed knots). ! This is a wrapper for [[db6ink]]. pure subroutine initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) iknot = 0_ip !knot sequence chosen by db6ink call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_6d]] type (with user-specified knots). ! This is a wrapper for [[db6ink]]. pure subroutine initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& ns = ns , ks = ks , ts = ts ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr me % ts = ts call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_6d]] interpolate. This is a wrapper for [[db6val]]. pure subroutine evaluate_6d ( me , xval , yval , zval , qval , rval , sval , idx , idy , idz , idq , idr , ids , f , iflag ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6val]]) if ( me % initialized ) then call db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % nx , me % ny , me % nz , me % nq , me % nr , me % ns ,& me % kx , me % ky , me % kz , me % kq , me % kr , me % ks ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr , me % inbvs ,& me % iloy , me % iloz , me % iloq , me % ilor , me % ilos ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 , me % work_val_6 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_6d !***************************************************************************************** !***************************************************************************************** !> ! Error checks for the user-specified knot vector sizes. ! !@note If more than one is the wrong size, then the `iflag` error code will ! correspond to the one with the highest rank. pure subroutine check_knot_vectors_sizes ( nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag ) implicit none integer ( ip ), intent ( in ), optional :: nx integer ( ip ), intent ( in ), optional :: ny integer ( ip ), intent ( in ), optional :: nz integer ( ip ), intent ( in ), optional :: nq integer ( ip ), intent ( in ), optional :: nr integer ( ip ), intent ( in ), optional :: ns integer ( ip ), intent ( in ), optional :: kx integer ( ip ), intent ( in ), optional :: ky integer ( ip ), intent ( in ), optional :: kz integer ( ip ), intent ( in ), optional :: kq integer ( ip ), intent ( in ), optional :: kr integer ( ip ), intent ( in ), optional :: ks real ( wp ), dimension (:), intent ( in ), optional :: tx real ( wp ), dimension (:), intent ( in ), optional :: ty real ( wp ), dimension (:), intent ( in ), optional :: tz real ( wp ), dimension (:), intent ( in ), optional :: tq real ( wp ), dimension (:), intent ( in ), optional :: tr real ( wp ), dimension (:), intent ( in ), optional :: ts integer ( ip ), intent ( out ) :: iflag !! 0 if everything is OK iflag = 0_ip if ( present ( nx ) . and . present ( kx ) . and . present ( tx )) then if ( size ( tx , kind = ip ) /= ( nx + kx )) then iflag = 501_ip ! tx is not the correct size (nx+kx) end if end if if ( present ( ny ) . and . present ( ky ) . and . present ( ty )) then if ( size ( ty , kind = ip ) /= ( ny + ky )) then iflag = 502_ip ! ty is not the correct size (ny+ky) end if end if if ( present ( nz ) . and . present ( kz ) . and . present ( tz )) then if ( size ( tz , kind = ip ) /= ( nz + kz )) then iflag = 503_ip ! tz is not the correct size (nz+kz) end if end if if ( present ( nq ) . and . present ( kq ) . and . present ( tq )) then if ( size ( tq , kind = ip ) /= ( nq + kq )) then iflag = 504_ip ! tq is not the correct size (nq+kq) end if end if if ( present ( nr ) . and . present ( kr ) . and . present ( tr )) then if ( size ( tr , kind = ip ) /= ( nr + kr )) then iflag = 505_ip ! tr is not the correct size (nr+kr) end if end if if ( present ( ns ) . and . present ( ks ) . and . present ( ts )) then if ( size ( ts , kind = ip ) /= ( ns + ks )) then iflag = 506_ip ! ts is not the correct size (ns+ks) end if end if end subroutine check_knot_vectors_sizes !***************************************************************************************** !***************************************************************************************** end module bspline_oo_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_oo_module.f90.html"}]} \ No newline at end of file +var tipuesearch = {"pages":[{"title":" bspline-fortran ","text":"bspline-fortran Multidimensional B-Spline Interpolation of Data on a Regular Grid. Status Brief description The library provides subroutines for 1D-6D interpolation and extrapolation using B-splines. The code is written in modern Fortran (i.e., Fortran 2003+). There are two ways to use the module, via a basic subroutine interface and an object-oriented interface. Both are thread safe. Subroutine interface The core routines for the subroutine interface are: !f(x) subroutine db1ink ( x , nx , fcn , kx , iknot , tx , bcoef , iflag ) subroutine db1val ( xval , idx , tx , nx , kx , bcoef , f , iflag , inbvx , w0 , extrap ) !f(x,y) subroutine db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , tx , ty , bcoef , iflag ) subroutine db2val ( xval , yval , idx , idy , tx , ty , nx , ny , kx , ky , bcoef , f , iflag , inbvx , inbvy , iloy , w1 , w0 , extrap ) !f(x,y,z) subroutine db3ink ( x , nx , y , ny , z , nz , fcn , kx , ky , kz , iknot , tx , ty , tz , bcoef , iflag ) subroutine db3val ( xval , yval , zval , idx , idy , idz , tx , ty , tz , nx , ny , nz , kx , ky , kz , bcoef , f , iflag , inbvx , inbvy , inbvz , iloy , iloz , w2 , w1 , w0 , extrap ) !f(x,y,z,q) subroutine db4ink ( x , nx , y , ny , z , nz , q , nq , fcn , kx , ky , kz , kq , iknot , tx , ty , tz , tq , bcoef , iflag ) subroutine db4val ( xval , yval , zval , qval , idx , idy , idz , idq , tx , ty , tz , tq , nx , ny , nz , nq , kx , ky , kz , kq , bcoef , f , iflag , inbvx , inbvy , inbvz , inbvq , iloy , iloz , iloq , w3 , w2 , w1 , w0 , extrap ) !f(x,y,z,q,r) subroutine db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr , fcn , kx , ky , kz , kq , kr , iknot , tx , ty , tz , tq , tr , bcoef , iflag ) subroutine db5val ( xval , yval , zval , qval , rval , idx , idy , idz , idq , idr , tx , ty , tz , tq , tr , nx , ny , nz , nq , nr , kx , ky , kz , kq , kr , bcoef , f , iflag , inbvx , inbvy , inbvz , inbvq , inbvr , iloy , iloz , iloq , ilor , w4 , w3 , w2 , w1 , w0 , extrap ) !f(x,y,z,q,r,s) subroutine db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns , fcn , kx , ky , kz , kq , kr , ks , iknot , tx , ty , tz , tq , tr , ts , bcoef , iflag ) subroutine db6val ( xval , yval , zval , qval , rval , sval , idx , idy , idz , idq , idr , ids , tx , ty , tz , tq , tr , ts , nx , ny , nz , nq , nr , ns , kx , ky , kz , kq , kr , ks , bcoef , f , iflag , inbvx , inbvy , inbvz , inbvq , inbvr , inbvs , iloy , iloz , iloq , ilor , ilos , w5 , w4 , w3 , w2 , w1 , w0 , extrap ) The ink routines compute the interpolant coefficients, and the val routines evalute the interpolant at the specified value of each coordinate. The 2D and 3D routines are extensively refactored versions of the original routines from the NIST Core Math Library . The others are new, and are simply extensions of the same algorithm into the other dimensions. Object-oriented interface In addition to the main subroutines, an object-oriented interface is also provided. For example, for the 3D case: type ( bspline_3d ) :: s call s % initialize ( x , y , z , fcn , kx , ky , kz , iflag , extrap ) call s % evaluate ( xval , yval , zval , idx , idy , idz , f , iflag ) call s % destroy () Which uses the default \"not-a-knot\" end conditions. You can also specify the knot vectors (in this case, tx , ty , and tz ) manually during class initialization: call s % initialize ( x , y , z , fcn , kx , ky , kz , tx , ty , tz , iflag , extrap ) The various bspline classes can also be initialized using constructors, which have similar interfaces as the initialize methods. For example: type ( bspline_3d ) :: s s = bspline_3d ( x , y , z , fcn , kx , ky , kz , iflag , extrap ) Spline order The various k inputs (i.e., kx , ky , etc.) specify the spline order for each dimension. The order is the polynomial degree + 1. For example: k=2 : Linear k=3 : Quadratic k=4 : Cubic etc. Extrapolation The library optionally supports extrapolation for points outside the range of the coefficients. This is disabled by default (in which case an error code is returned for points outside the bounds). To enable extrapolation, use the optional extrap input to the various db*val subroutines or the initialize methods from the object-oriented interface. Integration The library also contains routines for computing definite integrals of bsplines. There are two methods (currently only for 1D): Basic version: db1sqad ( integral in the object-oriented interface) -- Computes the integral on (x1,x2) of a b-spline by applying a 2, 6, or 10 point Gauss formula on subintervals of (x1,x2) . This is only valid for orders <= 20. More general version: db1fqad ( fintegral in the object-oriented interface) -- Computes the integral on (x1,x2) of a product of a user-defined function fun(x) and the ith derivative of a b-spline with an adaptive 8-point Legendre-Gauss algorithm. Note that extrapolation is not currently supported for these. Least squares fitting The BSpline-Fortran library also exports the defc subroutine, which can be used to fit B-spline polynomials to 1D data using a weighted least squares method. The dfc subroutine also allows for equality and inequality constraints to be imposed on the fitted curve. These procedures are not yet available in the object oriented interface. Examples See the examples for more details. Note that, to compile and run some of the test programs, the pyplot-fortran library (which is used to generate plots) is required. This will automatically be downloaded by FPM . Compiling The library can be compiled with recent versions the Intel Fortran Compiler and GFortran (and presumably any other Fortran compiler that supports modern standards). FPM A fmp.toml file is provided for compiling bspline-fortran with the Fortran Package Manager . For example, to build: fpm build --profile release By default, the library is built with double precision ( real64 ) real values and single precision ( int32 ) integer values. Explicitly specifying the real or integer kinds can be done using the following processor flags: Preprocessor flag Kind Number of bytes REAL32 real(kind=real32) 4 REAL64 real(kind=real64) 8 REAL128 real(kind=real128) 16 Preprocessor flag Kind Number of bytes INT8 integer(kind=int8) 1 INT16 integer(kind=int16) 2 INT32 integer(kind=int32) 4 INT64 integer(kind=int64) 8 For example, to build a single precision version of the library, use: fpm build --profile release --flag \"-DREAL32\" To run the unit tests: fpm test --profile release To use bspline-fortran within your fpm project, add the following to your fpm.toml file: [dependencies] bspline-fortran = { git = \"https://github.com/jacobwilliams/bspline-fortran.git\" } or, to use a specific version: [dependencies] bspline-fortran = { git = \"https://github.com/jacobwilliams/bspline-fortran.git\" , tag = \"7.3.0\" } CMake A basic CMake configuration file is also included. For example, to build a static library: mkdir build cd build cmake .. make Or, to build a shared library: cmake -DBUILD_SHARED_LIBS = ON .. For a debug build: cmake -DCMAKE_BUILD_TYPE = DEBUG .. Dependencies The library requires some BLAS routines, which are included. However, the user may also choose to link to an external BLAS library. This can be done by using the HAS_BLAS compiler directive. For example: fpm build --compiler gfortran --flag \"-DHAS_BLAS -lblas\" However, note that an external BLAS can only be used if the library is compiled with double precision ( real64 ) reals. Documentation The latest API documentation can be found here . This was generated from the source code using FORD (i.e. by running ford ford.md ). License The bspline-fortran source code and related files and documentation are distributed under a permissive free software license (BSD-style). Keywords Bspline, spline, interpolation, data fitting, multivariate interpolation, multidimensional interpolation, integration See also This library includes the public domain DBSPLIN and DTENSBS code from the NIST Core Math Library (CMLIB). SPLPAK Multidimensional least-squares cubic spline fitting FINTERP Multidimensional Linear Interpolation with Modern Fortran PCHIP Piecewise Cubic Hermite Interpolation. Regridpack Linear or cubic interpolation for 1D-4D grids. Developer Info Jacob Williams","tags":"home","loc":"index.html"},{"title":"bspline_class – bspline-fortran ","text":"type, public :: bspline_class Base class for the b-spline types Inherited by type~~bspline_class~~InheritedByGraph type~bspline_class bspline_class type~bspline_1d bspline_1d type~bspline_1d->type~bspline_class type~bspline_2d bspline_2d type~bspline_2d->type~bspline_class type~bspline_3d bspline_3d type~bspline_3d->type~bspline_class type~bspline_4d bspline_4d type~bspline_4d->type~bspline_class type~bspline_5d bspline_5d type~bspline_5d->type~bspline_class type~bspline_6d bspline_6d type~bspline_6d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: inbvx = 1_ip internal variable used by dbvalu for efficient processing integer(kind=ip), private :: iflag = 1_ip saved iflag from the list routine call. logical, private :: initialized = .false. true if the class is initialized and ready to use logical, private :: extrap = .false. if true, then extrapolation is allowed during evaluation Type-Bound Procedures procedure, private, non_overridable :: destroy_base destructor for the abstract type private pure subroutine destroy_base (me) Destructor for contents of the base bspline_class class.\n(this routine is called by the extended classes). Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me procedure, private, non_overridable :: set_extrap_flag internal routine to set the extrap flag private pure subroutine set_extrap_flag (me, extrap) Sets the extrap flag in the class. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me logical, intent(in), optional :: extrap if not present, then False is used procedure( destroy_func ), public, deferred :: destroy destructor pure subroutine destroy_func(me) Prototype interface for bspline destructor routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me procedure( size_func ), public, deferred :: size_of size of the structure in bits pure function size_func(me) result(s) Prototype interface for size routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Source Code type , public , abstract :: bspline_class !! Base class for the b-spline types private integer ( ip ) :: inbvx = 1_ip !! internal variable used by [[dbvalu]] for efficient processing integer ( ip ) :: iflag = 1_ip !! saved `iflag` from the list routine call. logical :: initialized = . false . !! true if the class is initialized and ready to use logical :: extrap = . false . !! if true, then extrapolation is allowed during evaluation contains private procedure , non_overridable :: destroy_base !! destructor for the abstract type procedure , non_overridable :: set_extrap_flag !! internal routine to set the `extrap` flag procedure ( destroy_func ), deferred , public :: destroy !! destructor procedure ( size_func ), deferred , public :: size_of !! size of the structure in bits procedure , public , non_overridable :: status_ok !! returns true if the last `iflag` status code was `=0`. procedure , public , non_overridable :: status_message => get_bspline_status_message !! retrieve the last !! status message procedure , public , non_overridable :: clear_flag => clear_bspline_flag !! to reset the `iflag` saved in the class. end type bspline_class","tags":"","loc":"type/bspline_class.html"},{"title":"bspline_1d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_1d Class for 1d b-spline interpolation. Note The 1D class also contains two methods\n for computing definite integrals. Inherits type~~bspline_1d~~InheritsGraph type~bspline_1d bspline_1d type~bspline_class bspline_class type~bspline_1d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db1val] work array of dimension 3*kx Constructor public interface bspline_1d Constructor for bspline_1d private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) Finalization Procedures final :: finalize_1d private pure elemental subroutine finalize_1d (me) Finalizer for bspline_1d class. Just a wrapper for destroy_1d . Arguments Type Intent Optional Attributes Name type( bspline_1d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots private pure subroutine initialize_1d_auto_knots (me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_1d_specify_knots (me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_1d_auto_knots private pure subroutine initialize_1d_auto_knots (me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_1d_specify_knots private pure subroutine initialize_1d_specify_knots (me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_1d private pure subroutine evaluate_1d (me, xval, idx, f, iflag) Evaluate a bspline_1d interpolate. This is a wrapper for db1val . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db1val ) procedure, public :: destroy => destroy_1d private pure subroutine destroy_1d (me) Destructor for bspline_1d class. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure, public :: size_of => size_1d private pure function size_1d (me) result(s) Actual size of a bspline_1d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits procedure, public :: integral => integral_1d private pure subroutine integral_1d (me, x1, x2, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1sqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(out) :: f integral of the b-spline over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) procedure, public :: fintegral => fintegral_1d private subroutine fintegral_1d (me, fun, idx, x1, x2, tol, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1fqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv) integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(in) :: tol desired accuracy for the quadrature real(kind=wp), intent(out) :: f integral of bf(x) over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) Source Code type , extends ( bspline_class ), public :: bspline_1d !! Class for 1d b-spline interpolation. !! !!@note The 1D class also contains two methods !! for computing definite integrals. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x real ( wp ), dimension (:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db1val] work array of dimension `3*kx` contains private generic , public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots procedure :: initialize_1d_auto_knots procedure :: initialize_1d_specify_knots procedure , public :: evaluate => evaluate_1d procedure , public :: destroy => destroy_1d procedure , public :: size_of => size_1d procedure , public :: integral => integral_1d procedure , public :: fintegral => fintegral_1d final :: finalize_1d end type bspline_1d","tags":"","loc":"type/bspline_1d.html"},{"title":"bspline_2d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_2d Class for 2d b-spline interpolation. Inherits type~~bspline_2d~~InheritsGraph type~bspline_2d bspline_2d type~bspline_class bspline_class type~bspline_2d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db2val] work array of dimension ky real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db2val] work array of dimension 3_ip*max(kx,ky) Constructor public interface bspline_2d Constructor for bspline_2d private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) Finalization Procedures final :: finalize_2d private pure elemental subroutine finalize_2d (me) Finalizer for bspline_2d class. Just a wrapper for destroy_2d . Arguments Type Intent Optional Attributes Name type( bspline_2d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots private pure subroutine initialize_2d_auto_knots (me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_2d_specify_knots (me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_2d_auto_knots private pure subroutine initialize_2d_auto_knots (me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_2d_specify_knots private pure subroutine initialize_2d_specify_knots (me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_2d private pure subroutine evaluate_2d (me, xval, yval, idx, idy, f, iflag) Evaluate a bspline_2d interpolate. This is a wrapper for db2val . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db2val ) procedure, public :: destroy => destroy_2d private pure subroutine destroy_2d (me) Destructor for bspline_2d class. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me procedure, public :: size_of => size_2d private pure function size_2d (me) result(s) Actual size of a bspline_2d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_2d !! Class for 2d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y real ( wp ), dimension (:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db2val] work array of dimension `ky` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db2val] work array of dimension `3_ip*max(kx,ky)` contains private generic , public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots procedure :: initialize_2d_auto_knots procedure :: initialize_2d_specify_knots procedure , public :: evaluate => evaluate_2d procedure , public :: destroy => destroy_2d procedure , public :: size_of => size_2d final :: finalize_2d end type bspline_2d","tags":"","loc":"type/bspline_2d.html"},{"title":"bspline_3d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_3d Class for 3d b-spline interpolation. Inherits type~~bspline_3d~~InheritsGraph type~bspline_3d bspline_3d type~bspline_class bspline_class type~bspline_3d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:), allocatable :: work_val_1 [[db3val] work array of dimension ky,kz real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db3val] work array of dimension kz real(kind=wp), private, dimension(:), allocatable :: work_val_3 [[db3val] work array of dimension 3_ip*max(kx,ky,kz) Constructor public interface bspline_3d Constructor for bspline_3d private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) Finalization Procedures final :: finalize_3d private pure elemental subroutine finalize_3d (me) Finalizer for bspline_3d class. Just a wrapper for destroy_3d . Arguments Type Intent Optional Attributes Name type( bspline_3d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots private pure subroutine initialize_3d_auto_knots (me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_3d_specify_knots (me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_3d_auto_knots private pure subroutine initialize_3d_auto_knots (me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_3d_specify_knots private pure subroutine initialize_3d_specify_knots (me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_3d private pure subroutine evaluate_3d (me, xval, yval, zval, idx, idy, idz, f, iflag) Evaluate a bspline_3d interpolate. This is a wrapper for db3val . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db3val ) procedure, public :: destroy => destroy_3d private pure subroutine destroy_3d (me) Destructor for bspline_3d class. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me procedure, public :: size_of => size_3d private pure function size_3d (me) result(s) Actual size of a bspline_3d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_3d !! Class for 3d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z real ( wp ), dimension (:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:), allocatable :: work_val_1 !! [[db3val] work array of dimension `ky,kz` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db3val] work array of dimension `kz` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db3val] work array of dimension `3_ip*max(kx,ky,kz)` contains private generic , public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots procedure :: initialize_3d_auto_knots procedure :: initialize_3d_specify_knots procedure , public :: evaluate => evaluate_3d procedure , public :: destroy => destroy_3d procedure , public :: size_of => size_3d final :: finalize_3d end type bspline_3d","tags":"","loc":"type/bspline_3d.html"},{"title":"bspline_4d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_4d Class for 4d b-spline interpolation. Inherits type~~bspline_4d~~InheritsGraph type~bspline_4d bspline_4d type~bspline_class bspline_class type~bspline_4d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_1 db4val work array of dimension ky,kz,kq real(kind=wp), private, dimension(:,:), allocatable :: work_val_2 db4val work array of dimension kz,kq real(kind=wp), private, dimension(:), allocatable :: work_val_3 db4val work array of dimension kq real(kind=wp), private, dimension(:), allocatable :: work_val_4 db4val work array of dimension 3_ip*max(kx,ky,kz,kq) Constructor public interface bspline_4d Constructor for bspline_4d private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) Finalization Procedures final :: finalize_4d private pure elemental subroutine finalize_4d (me) Finalizer for bspline_4d class. Just a wrapper for destroy_4d . Arguments Type Intent Optional Attributes Name type( bspline_4d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots private pure subroutine initialize_4d_auto_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_4d_specify_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_4d_auto_knots private pure subroutine initialize_4d_auto_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_4d_specify_knots private pure subroutine initialize_4d_specify_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_4d private pure subroutine evaluate_4d (me, xval, yval, zval, qval, idx, idy, idz, idq, f, iflag) Evaluate a bspline_4d interpolate. This is a wrapper for db4val . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db4val ) procedure, public :: destroy => destroy_4d private pure subroutine destroy_4d (me) Destructor for bspline_4d class. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me procedure, public :: size_of => size_4d private pure function size_4d (me) result(s) Actual size of a bspline_4d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_4d !! Class for 4d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q real ( wp ), dimension (:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:), allocatable :: work_val_1 !! [[db4val]] work array of dimension `ky,kz,kq` real ( wp ), dimension (:,:), allocatable :: work_val_2 !! [[db4val]] work array of dimension `kz,kq` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db4val]] work array of dimension `kq` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db4val]] work array of dimension `3_ip*max(kx,ky,kz,kq)` contains private generic , public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots procedure :: initialize_4d_auto_knots procedure :: initialize_4d_specify_knots procedure , public :: evaluate => evaluate_4d procedure , public :: destroy => destroy_4d procedure , public :: size_of => size_4d final :: finalize_4d end type bspline_4d","tags":"","loc":"type/bspline_4d.html"},{"title":"bspline_5d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_5d Class for 5d b-spline interpolation. Inherits type~~bspline_5d~~InheritsGraph type~bspline_5d bspline_5d type~bspline_class bspline_class type~bspline_5d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_1 db5val work array of dimension ky,kz,kq,kr real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_2 db5val work array of dimension kz,kq,kr real(kind=wp), private, dimension(:,:), allocatable :: work_val_3 db5val work array of dimension kq,kr real(kind=wp), private, dimension(:), allocatable :: work_val_4 db5val work array of dimension kr real(kind=wp), private, dimension(:), allocatable :: work_val_5 db5val work array of dimension 3_ip*max(kx,ky,kz,kq,kr) Constructor public interface bspline_5d Constructor for bspline_5d private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) Finalization Procedures final :: finalize_5d private pure elemental subroutine finalize_5d (me) Finalizer for bspline_5d class. Just a wrapper for destroy_5d . Arguments Type Intent Optional Attributes Name type( bspline_5d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots private pure subroutine initialize_5d_auto_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_5d_specify_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_5d_auto_knots private pure subroutine initialize_5d_auto_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_5d_specify_knots private pure subroutine initialize_5d_specify_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_5d private pure subroutine evaluate_5d (me, xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, f, iflag) Evaluate a bspline_5d interpolate. This is a wrapper for db5val . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db5val ) procedure, public :: destroy => destroy_5d private pure subroutine destroy_5d (me) Destructor for bspline_5d class. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me procedure, public :: size_of => size_5d private pure function size_5d (me) result(s) Actual size of a bspline_5d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_5d !! Class for 5d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r real ( wp ), dimension (:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:), allocatable :: work_val_1 !! [[db5val]] work array of dimension `ky,kz,kq,kr` real ( wp ), dimension (:,:,:), allocatable :: work_val_2 !! [[db5val]] work array of dimension `kz,kq,kr` real ( wp ), dimension (:,:), allocatable :: work_val_3 !! [[db5val]] work array of dimension `kq,kr` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db5val]] work array of dimension `kr` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db5val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr)` contains private generic , public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots procedure :: initialize_5d_auto_knots procedure :: initialize_5d_specify_knots procedure , public :: evaluate => evaluate_5d procedure , public :: destroy => destroy_5d procedure , public :: size_of => size_5d final :: finalize_5d end type bspline_5d","tags":"","loc":"type/bspline_5d.html"},{"title":"bspline_6d – bspline-fortran ","text":"type, public, extends( bspline_class ) :: bspline_6d Class for 6d b-spline interpolation. Inherits type~~bspline_6d~~InheritsGraph type~bspline_6d bspline_6d type~bspline_class bspline_class type~bspline_6d->type~bspline_class Help Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: ns = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in integer(kind=ip), private :: ks = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ts The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvs = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilos = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: work_val_1 db6val work array of dimension ky,kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_2 db6val work array of dimension kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_3 db6val work array of dimension kq,kr,ks real(kind=wp), private, dimension(:,:), allocatable :: work_val_4 db6val work array of dimension kr,ks real(kind=wp), private, dimension(:), allocatable :: work_val_5 db6val work array of dimension ks real(kind=wp), private, dimension(:), allocatable :: work_val_6 db6val work array of dimension 3_ip*max(kx,ky,kz,kq,kr,ks) Constructor public interface bspline_6d Constructor for bspline_6d private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Finalization Procedures final :: finalize_6d private pure elemental subroutine finalize_6d (me) Finalizer for bspline_6d class. Just a wrapper for destroy_6d . Arguments Type Intent Optional Attributes Name type( bspline_6d ), intent(inout) :: me Type-Bound Procedures procedure, public, non_overridable :: status_ok returns true if the last iflag status code was =0 . private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical procedure, public, non_overridable :: status_message => get_bspline_status_message retrieve the last\nstatus message private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag procedure, public, non_overridable :: clear_flag => clear_bspline_flag to reset the iflag saved in the class. private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me generic, public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots private pure subroutine initialize_6d_auto_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_6d_specify_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_6d_auto_knots private pure subroutine initialize_6d_auto_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, private :: initialize_6d_specify_knots private pure subroutine initialize_6d_specify_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) procedure, public :: evaluate => evaluate_6d private pure subroutine evaluate_6d (me, xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, f, iflag) Evaluate a bspline_6d interpolate. This is a wrapper for db6val . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db6val ) procedure, public :: destroy => destroy_6d private pure subroutine destroy_6d (me) Destructor for bspline_6d class. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me procedure, public :: size_of => size_6d private pure function size_6d (me) result(s) Actual size of a bspline_6d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code type , extends ( bspline_class ), public :: bspline_6d !! Class for 6d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: ns = 0_ip !! Number of s abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r integer ( ip ) :: ks = 0_ip !! The order of spline pieces in s real ( wp ), dimension (:,:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ts !! The knots in the s direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvs = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilos = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:,:), allocatable :: work_val_1 !! [[db6val]] work array of dimension `ky,kz,kq,kr,ks` real ( wp ), dimension (:,:,:,:), allocatable :: work_val_2 !! [[db6val]] work array of dimension `kz,kq,kr,ks` real ( wp ), dimension (:,:,:), allocatable :: work_val_3 !! [[db6val]] work array of dimension `kq,kr,ks` real ( wp ), dimension (:,:), allocatable :: work_val_4 !! [[db6val]] work array of dimension `kr,ks` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db6val]] work array of dimension `ks` real ( wp ), dimension (:), allocatable :: work_val_6 !! [[db6val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr,ks)` contains private generic , public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots procedure :: initialize_6d_auto_knots procedure :: initialize_6d_specify_knots procedure , public :: evaluate => evaluate_6d procedure , public :: destroy => destroy_6d procedure , public :: size_of => size_6d final :: finalize_6d end type bspline_6d","tags":"","loc":"type/bspline_6d.html"},{"title":"b1fqad_func – bspline-fortran","text":"interface public function b1fqad_func(x) result(f) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x Return Value real(kind=wp) f(x) Description interface for the input function in dbfqad","tags":"","loc":"interface/b1fqad_func.html"},{"title":"size_func – bspline-fortran","text":"interface private pure function size_func(me) result(s) Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Description interface for size routines","tags":"","loc":"interface/size_func.html"},{"title":"destroy_func – bspline-fortran","text":"interface private pure subroutine destroy_func(me) Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Description interface for bspline destructor routines","tags":"","loc":"interface/destroy_func.html"},{"title":"check_value – bspline-fortran","text":"private pure function check_value(x, t, i, extrap) result(iflag) Checks if the value is withing the range of the knot vectors.\nThis is called by the various db*val routines. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x the value to check real(kind=wp), intent(in), dimension(:) :: t the knot vector integer(kind=ip), intent(in) :: i 1=x, 2=y, 3=z, 4=q, 5=r, 6=s logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value integer(kind=ip) returns 0 if value is OK, otherwise returns 600+i Called by proc~~check_value~~CalledByGraph proc~check_value bspline_sub_module::check_value proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~check_value proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~check_value proc~db2val bspline_sub_module::db2val proc~db2val->proc~check_value proc~db3val bspline_sub_module::db3val proc~db3val->proc~check_value proc~db4val bspline_sub_module::db4val proc~db4val->proc~check_value proc~db5val bspline_sub_module::db5val proc~db5val->proc~check_value proc~db6val bspline_sub_module::db6val proc~db6val->proc~check_value interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function check_value ( x , t , i , extrap ) result ( iflag ) implicit none integer ( ip ) :: iflag !! returns 0 if value is OK, otherwise returns `600+i` real ( wp ), intent ( in ) :: x !! the value to check integer ( ip ), intent ( in ) :: i !! 1=x, 2=y, 3=z, 4=q, 5=r, 6=s real ( wp ), dimension (:), intent ( in ) :: t !! the knot vector logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: allow_extrapolation !! if extrapolation is allowed if ( present ( extrap )) then allow_extrapolation = extrap else allow_extrapolation = . false . end if if ( allow_extrapolation ) then ! in this case all values are OK iflag = 0_ip else if ( x < t ( 1_ip ) . or . x > t ( size ( t , kind = ip ))) then iflag = 600_ip + i ! value out of bounds (601, 602, etc.) else iflag = 0_ip end if end if end function check_value","tags":"","loc":"proc/check_value.html"},{"title":"get_temp_x_for_extrap – bspline-fortran","text":"private pure function get_temp_x_for_extrap(x, tmin, tmax, extrap) result(xt) Returns the value of x to use for computing the interval\nin t , depending on if extrapolation is allowed or not. If extrapolation is allowed and x is < tmin or > tmax, then either tmin or tmax - 2.0_wp*spacing(tmax) is returned.\nOtherwise, x is returned. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x variable value real(kind=wp), intent(in) :: tmin first knot vector element for b-splines real(kind=wp), intent(in) :: tmax last knot vector element for b-splines logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value real(kind=wp) The value returned (it will either\nbe tmin , x , or tmax ) Called by proc~~get_temp_x_for_extrap~~CalledByGraph proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv bspline_sub_module::dintrv proc~dintrv->proc~get_temp_x_for_extrap proc~db2val bspline_sub_module::db2val proc~db2val->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~db3val bspline_sub_module::db3val proc~db3val->proc~dintrv proc~db3val->proc~dbvalu proc~db4val bspline_sub_module::db4val proc~db4val->proc~dintrv proc~db4val->proc~dbvalu proc~db5val bspline_sub_module::db5val proc~db5val->proc~dintrv proc~db5val->proc~dbvalu proc~db6val bspline_sub_module::db6val proc~db6val->proc~dintrv proc~db6val->proc~dbvalu proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dintrv proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dbsqad bspline_sub_module::dbsqad proc~dbsqad->proc~dintrv proc~dbsqad->proc~dbvalu proc~dbvalu->proc~dintrv proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~dbvalu proc~dbsgq8->proc~dbvalu proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function get_temp_x_for_extrap ( x , tmin , tmax , extrap ) result ( xt ) implicit none real ( wp ), intent ( in ) :: x !! variable value real ( wp ), intent ( in ) :: tmin !! first knot vector element for b-splines real ( wp ), intent ( in ) :: tmax !! last knot vector element for b-splines real ( wp ) :: xt !! The value returned (it will either !! be `tmin`, `x`, or `tmax`) logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: extrapolation_allowed !! if extrapolation is allowed if ( present ( extrap )) then extrapolation_allowed = extrap else extrapolation_allowed = . false . end if if ( extrapolation_allowed ) then if ( x < tmin ) then xt = tmin else if ( x > tmax ) then ! Put it just inside the upper bound. ! This is sort of a hack to get ! extrapolation to work. xt = tmax - 2.0_wp * spacing ( tmax ) else xt = x end if else xt = x end if end function get_temp_x_for_extrap","tags":"","loc":"proc/get_temp_x_for_extrap.html"},{"title":"get_status_message – bspline-fortran","text":"public pure function get_status_message(iflag) result(msg) Returns a message string associated with the status code. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iflag return code from one of the routines Return Value character(len=:), allocatable status message associated with the flag Called by proc~~get_status_message~~CalledByGraph proc~get_status_message bspline_sub_module::get_status_message proc~get_bspline_status_message bspline_oo_module::bspline_class%get_bspline_status_message proc~get_bspline_status_message->proc~get_status_message Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function get_status_message ( iflag ) result ( msg ) implicit none integer ( ip ), intent ( in ) :: iflag !! return code from one of the routines character ( len = :), allocatable :: msg !! status message associated with the flag character ( len = 10 ) :: istr !! for integer to string conversion integer ( ip ) :: istat !! for write statement select case ( iflag ) case ( 0_ip ); msg = 'Successful execution' case ( - 1_ip ); msg = 'Error in dintrv: x < xt(1_ip)' case ( - 2_ip ); msg = 'Error in dintrv: x >= xt(lxt)' case ( 1_ip ); msg = 'Error in evaluate_*d: class is not initialized' case ( 2_ip ); msg = 'Error in db*ink: iknot out of range' case ( 3_ip ); msg = 'Error in db*ink: nx out of range' case ( 4_ip ); msg = 'Error in db*ink: kx out of range' case ( 5_ip ); msg = 'Error in db*ink: x not strictly increasing' case ( 6_ip ); msg = 'Error in db*ink: tx not non-decreasing' case ( 7_ip ); msg = 'Error in db*ink: ny out of range' case ( 8_ip ); msg = 'Error in db*ink: ky out of range' case ( 9_ip ); msg = 'Error in db*ink: y not strictly increasing' case ( 10_ip ); msg = 'Error in db*ink: ty not non-decreasing' case ( 11_ip ); msg = 'Error in db*ink: nz out of range' case ( 12_ip ); msg = 'Error in db*ink: kz out of range' case ( 13_ip ); msg = 'Error in db*ink: z not strictly increasing' case ( 14_ip ); msg = 'Error in db*ink: tz not non-decreasing' case ( 15_ip ); msg = 'Error in db*ink: nq out of range' case ( 16_ip ); msg = 'Error in db*ink: kq out of range' case ( 17_ip ); msg = 'Error in db*ink: q not strictly increasing' case ( 18_ip ); msg = 'Error in db*ink: tq not non-decreasing' case ( 19_ip ); msg = 'Error in db*ink: nr out of range' case ( 20_ip ); msg = 'Error in db*ink: kr out of range' case ( 21_ip ); msg = 'Error in db*ink: r not strictly increasing' case ( 22_ip ); msg = 'Error in db*ink: tr not non-decreasing' case ( 23_ip ); msg = 'Error in db*ink: ns out of range' case ( 24_ip ); msg = 'Error in db*ink: ks out of range' case ( 25_ip ); msg = 'Error in db*ink: s not strictly increasing' case ( 26_ip ); msg = 'Error in db*ink: ts not non-decreasing' case ( 700_ip ); msg = 'Error in db*ink: size(x) /= size(fcn,1)' case ( 701_ip ); msg = 'Error in db*ink: size(y) /= size(fcn,2)' case ( 702_ip ); msg = 'Error in db*ink: size(z) /= size(fcn,3)' case ( 703_ip ); msg = 'Error in db*ink: size(q) /= size(fcn,4)' case ( 704_ip ); msg = 'Error in db*ink: size(r) /= size(fcn,5)' case ( 705_ip ); msg = 'Error in db*ink: size(s) /= size(fcn,6)' case ( 706_ip ); msg = 'Error in db*ink: size(x) /= nx' case ( 707_ip ); msg = 'Error in db*ink: size(y) /= ny' case ( 708_ip ); msg = 'Error in db*ink: size(z) /= nz' case ( 709_ip ); msg = 'Error in db*ink: size(q) /= nq' case ( 710_ip ); msg = 'Error in db*ink: size(r) /= nr' case ( 711_ip ); msg = 'Error in db*ink: size(s) /= ns' case ( 712_ip ); msg = 'Error in db*ink: size(tx) /= nx+kx' case ( 713_ip ); msg = 'Error in db*ink: size(ty) /= ny+ky' case ( 714_ip ); msg = 'Error in db*ink: size(tz) /= nz+kz' case ( 715_ip ); msg = 'Error in db*ink: size(tq) /= nq+kq' case ( 716_ip ); msg = 'Error in db*ink: size(tr) /= nr+kr' case ( 717_ip ); msg = 'Error in db*ink: size(ts) /= ns+ks' case ( 800_ip ); msg = 'Error in db*ink: size(x) /= size(bcoef,1)' case ( 801_ip ); msg = 'Error in db*ink: size(y) /= size(bcoef,2)' case ( 802_ip ); msg = 'Error in db*ink: size(z) /= size(bcoef,3)' case ( 803_ip ); msg = 'Error in db*ink: size(q) /= size(bcoef,4)' case ( 804_ip ); msg = 'Error in db*ink: size(r) /= size(bcoef,5)' case ( 805_ip ); msg = 'Error in db*ink: size(s) /= size(bcoef,6)' case ( 806_ip ); msg = 'Error in dbint4: currently, only k=4 can be used' case ( 100_ip ); msg = 'Error in dbintk: k does not satisfy k>=1' case ( 101_ip ); msg = 'Error in dbintk: n does not satisfy n>=k' case ( 102_ip ); msg = 'Error in dbintk: x(i) does not satisfy x(i)proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1ink_default~~CalledByGraph proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1ink_default ( x , nx , fcn , kx , iknot , tx , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant: !! !! * If `iknot=0` these are chosen by [[db1ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( out ) :: bcoef !! `(nx)` array of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)`. !! * 706 = `size(x)` \\ne `nx`. !! * 712 = `size(tx)` \\ne `nx+kx`. !! * 800 = `size(x)` \\ne `size(bcoef,1)`. logical :: status_ok real ( wp ), dimension (:), allocatable :: work !! work array of dimension `2*kx*(nx+1)` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) end if allocate ( work ( 2_ip * kx * ( nx + 1_ip ))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , 1_ip , tx , kx , bcoef , work , iflag ) deallocate ( work ) end if end subroutine db1ink_default","tags":"","loc":"proc/db1ink_default.html"},{"title":"db1ink_alt – bspline-fortran","text":"private pure subroutine db1ink_alt(x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: ibcl = 1 constrain the first derivative at x(1) to fbcl ibcl = 2 constrain the second derivative at x(1) to fbcl integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: ibcr = 1 constrain first derivative at x(nx) to fbcr ibcr = 2 constrain second derivative at x(nx) to fbcr real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: kntopt = 1 sets knot multiplicity at t(4) and t(nx+3) to 4 kntopt = 2 sets a symmetric placement of knots\n about t(4) and t(nx+3) real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 806: dbint4 can only be used when k=4 Calls proc~~db1ink_alt~~CallsGraph proc~db1ink_alt bspline_sub_module::db1ink_alt proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1ink_alt~~CalledByGraph proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1ink_alt ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , kntopt , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(nx+3)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(nx+3)` real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when `k=4` real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (n=nx+2) integer ( ip ) :: k !! order of spline (k=4) logical :: status_ok !! status flag for error checking real ( wp ), dimension ( 3 ), parameter :: tleft = 0.0_wp !! not used for this case (see [[dbint4]]) real ( wp ), dimension ( 3 ), parameter :: tright = 0.0_wp !! not used for this case (see [[dbint4]]) if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5_ip , nx + 2_ip )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt","tags":"","loc":"proc/db1ink_alt.html"},{"title":"db1ink_alt_2 – bspline-fortran","text":"private pure subroutine db1ink_alt_2(x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: ibcl = 1 constrain the first derivative at x(1) to fbcl ibcl = 2 constrain the second derivative at x(1) to fbcl integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: ibcr = 1 constrain first derivative at x(nx) to fbcr ibcr = 2 constrain second derivative at x(nx) to fbcr real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 806: dbint4 can only be used when k=4 Calls proc~~db1ink_alt_2~~CallsGraph proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt_2->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt_2->proc~dbint4 proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1ink_alt_2~~CalledByGraph proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1ink_alt_2 ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , tleft , tright , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! `t(1:3)` in increasing order supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! `t(nx+4:nx+6)` in increasing order supplied by the user. real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when k=4 real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (`n=nx+2`) integer ( ip ) :: k !! order of spline (`k=4`) logical :: status_ok !! status flag for error checking integer ( ip ), parameter :: kntopt = 3 !! use `tleft` and `tright` in [[dbint4]] if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5 , nx + 2 )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt_2","tags":"","loc":"proc/db1ink_alt_2.html"},{"title":"db1val_default – bspline-fortran","text":"private pure subroutine db1val_default(xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . To evaluate the interpolant itself, set idx=0 ,\n to evaluate the first partial with respect to x , set idx=1 , and so on. db1val returns 0.0 if ( xval , yval ) is out of range. that is, if xval < tx ( 1 ) . or . xval > tx ( nx + kx ) if the knots tx were chosen by db1ink , then this is equivalent to: xval < x ( 1 ) . or . xval > x ( nx ) + epsx where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) The input quantities tx , nx , kx , and bcoef should be\n unchanged since the last call of db1ink . History Jacob Williams, 10/30/2015 : Created 1D routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db1val_default~~CallsGraph proc~db1val_default bspline_sub_module::db1val_default proc~check_value bspline_sub_module::check_value proc~db1val_default->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_default->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1val_default~~CalledByGraph proc~db1val_default bspline_sub_module::db1val_default interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_default proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1val_default ( xval , idx , tx , nx , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db1ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db1ink]]) real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , nx , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_default","tags":"","loc":"proc/db1val_default.html"},{"title":"db1val_alt – bspline-fortran","text":"private pure subroutine db1val_alt(xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db1val_alt~~CallsGraph proc~db1val_alt bspline_sub_module::db1val_alt proc~check_value bspline_sub_module::check_value proc~db1val_alt->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1val_alt~~CalledByGraph proc~db1val_alt bspline_sub_module::db1val_alt interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1val_alt ( xval , idx , tx , nx , n , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. integer ( ip ), intent ( in ) :: n !! length of `bcoef`: `nx+2` integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), dimension ( n + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , n , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_alt","tags":"","loc":"proc/db1val_alt.html"},{"title":"db1sqad – bspline-fortran","text":"public pure subroutine db1sqad(tx, bcoef, nx, kx, x1, x2, f, iflag, w0) Computes the integral on (x1,x2) of a kx -th order b-spline.\n Orders kx as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. See also dbsqad -- the core routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(out) :: f integral of the b-spline over ( x1 , x2 ) integer(kind=ip), intent(out) :: iflag status flag: : no errors : error real(kind=wp), intent(inout), dimension(3*kx) :: w0 work array for dbsqad Calls proc~~db1sqad~~CallsGraph proc~db1sqad bspline_sub_module::db1sqad proc~dbsqad bspline_sub_module::dbsqad proc~db1sqad->proc~dbsqad proc~dbvalu bspline_sub_module::dbvalu proc~dbsqad->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbsqad->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1sqad~~CalledByGraph proc~db1sqad bspline_sub_module::db1sqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db1sqad ( tx , bcoef , nx , kx , x1 , x2 , f , iflag , w0 ) implicit none integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `1 <= k <= 20` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( out ) :: f !! integral of the b-spline over (`x1`,`x2`) integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3 * kx ), intent ( inout ) :: w0 !! work array for [[dbsqad]] call dbsqad ( tx , bcoef , nx , kx , x1 , x2 , f , w0 , iflag ) end subroutine db1sqad","tags":"","loc":"proc/db1sqad.html"},{"title":"db1fqad – bspline-fortran","text":"public subroutine db1fqad(fun, tx, bcoef, nx, kx, idx, x1, x2, tol, f, iflag, w0) Computes the integral on (x1,x2) of a product of a\n function fun and the idx -th derivative of a kx -th order b-spline,\n using the b-representation (tx,bcoef,nx,kx) , with an adaptive\n 8-point Legendre-Gauss algorithm. (x1,x2) must be a subinterval of t(kx) <= x <= t(nx+1) . See also dbfqad -- the core routine. Note This one is not pure, because we are not enforcing\n that the user function fun be pure. Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work) real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, kx >= 1 integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: f integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: : no errors : error real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array for dbfqad Calls proc~~db1fqad~~CallsGraph proc~db1fqad bspline_sub_module::db1fqad proc~dbfqad bspline_sub_module::dbfqad proc~db1fqad->proc~dbfqad proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dintrv bspline_sub_module::dintrv proc~dbfqad->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap proc~dbvalu->proc~dintrv Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db1fqad~~CalledByGraph proc~db1fqad bspline_sub_module::db1fqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine db1fqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) implicit none procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work)` integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `kx >= 1` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: f !! integral of `bf(x)` on `(x1,x2)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array for [[dbfqad]] call dbfqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) end subroutine db1fqad","tags":"","loc":"proc/db1fqad.html"},{"title":"db2ink – bspline-fortran","text":"public pure subroutine db2ink(x, nx, y, ny, fcn, kx, ky, iknot, tx, ty, bcoef, iflag) Determines the parameters of a function that interpolates\n the two-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db2val . The interpolating function is a piecewise polynomial function\n represented as a tensor product of one-dimensional b-splines. the\n form of this function is where the functions and are one-dimensional b-spline\n basis functions. the coefficients are chosen so that Note that for each fixed value of , is a piecewise\n polynomial function of alone, and for each fixed value of , is a piecewise polynomial function of alone. in one dimension\n a piecewise polynomial may be created by partitioning a given\n interval into subintervals and defining a distinct polynomial piece\n on each one. the points where adjacent subintervals meet are called\n knots. each of the functions and above is a piecewise\n polynomial. Users of db2ink choose the order (degree+1) of the polynomial\n pieces used to define the piecewise polynomial in each of the and directions ( kx and ky ). users also may define their own knot\n sequence in and separately ( tx and ty ). if iflag=0 , however, db2ink will choose sequences of knots that result in a piecewise\n polynomial interpolant with kx-2 continuous partial derivatives in and ky-2 continuous partial derivatives in . ( kx knots are taken\n near each endpoint in the direction, not-a-knot end conditions\n are used, and the remaining knots are placed at data points if kx is even or at midpoints between data points if kx is odd. the direction is treated similarly.) After a call to db2ink , all information necessary to define the\n interpolating function are contained in the parameters nx , ny , kx , ky , tx , ty , and bcoef . These quantities should not be altered until\n after the last call of the evaluation routine db2val . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: ny Number of abcissae real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db1ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db2ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db2ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:) :: bcoef (nx,ny) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 706 = size(x) nx 707 = size(y) ny 712 = size(tx) nx+kx 713 = size(ty) ny+ky 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) Calls proc~~db2ink~~CallsGraph proc~db2ink bspline_sub_module::db2ink proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db2ink~~CalledByGraph proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , tx , ty , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: ny !! Number of y abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:), intent ( out ) :: bcoef !! `(nx,ny)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1),2*ky*(ny+1))` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny ,& kx = kx , ky = ky ,& x = x , y = y ,& tx = tx , ty = ty ,& f2 = fcn ,& bcoef2 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) end if allocate ( temp ( nx * ny )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip )))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx , ty , ky , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db2ink","tags":"","loc":"proc/db2ink.html"},{"title":"db2val – bspline-fortran","text":"public pure subroutine db2val(xval, yval, idx, idy, tx, ty, nx, ny, kx, ky, bcoef, f, iflag, inbvx, inbvy, iloy, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db2ink or one of its\n derivatives at the point ( xval , yval ). To evaluate the interpolant\n itself, set idx=idy=0 , to evaluate the first partial with respect\n to x , set idx=1,idy=0 , and so on. db2val returns 0.0 if (xval,yval) is out of range. that is, if xval < tx ( 1 ) . or . xval > tx ( nx + kx ) . or . yval < ty ( 1 ) . or . yval > ty ( ny + ky ) if the knots tx and ty were chosen by db2ink , then this is equivalent to: xval < x ( 1 ) . or . xval > x ( nx ) + epsx . or . yval < y ( 1 ) . or . yval > y ( ny ) + epsy where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) epsy = 0.1 * ( y ( ny ) - y ( ny - 1 )) The input quantities tx , ty , nx , ny , kx , ky , and bcoef should be\n unchanged since the last call of db2ink . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise\npolynomial in the direction.\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(nx,ny) :: bcoef the b-spline coefficients computed by db2ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db2val~~CallsGraph proc~db2val bspline_sub_module::db2val proc~check_value bspline_sub_module::check_value proc~db2val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db2val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db2val~~CalledByGraph proc~db2val bspline_sub_module::db2val proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db2val ( xval , yval , idx , idy , tx , ty , nx , ny , kx , ky , bcoef , f , iflag , inbvx , inbvy , iloy , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db2ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise !! polynomial in the y direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( nx , ny ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db2ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: k , lefty , kcol f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return kcol = lefty - ky do k = 1_ip , ky kcol = kcol + 1_ip call dbvalu ( tx , bcoef (:, kcol ), nx , kx , idx , xval , inbvx , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return !error end do kcol = lefty - ky + 1_ip call dbvalu ( ty ( kcol :), w1 , ky , ky , idy , yval , inbvy , w0 , iflag , f , extrap ) end subroutine db2val","tags":"","loc":"proc/db2val.html"},{"title":"db3ink – bspline-fortran","text":"public pure subroutine db3ink(x, nx, y, ny, z, nz, fcn, kx, ky, kz, iknot, tx, ty, tz, bcoef, iflag) Determines the parameters of a function that interpolates\n the three-dimensional gridded data The interpolating function and\n its derivatives may subsequently be evaluated by the function db3val . The interpolating function is a piecewise polynomial function\n represented as a tensor product of one-dimensional b-splines. the\n form of this function is where the functions , , and are one-dimensional b-\n spline basis functions. the coefficients are chosen so that: Note that for fixed values of and is a piecewise\n polynomial function of alone, for fixed values of and is a piecewise polynomial function of alone, and for fixed\n values of and is a function of alone. in one\n dimension a piecewise polynomial may be created by partitioning a\n given interval into subintervals and defining a distinct polynomial\n piece on each one. the points where adjacent subintervals meet are\n called knots. each of the functions , , and above is a\n piecewise polynomial. Users of db3ink choose the order (degree+1) of the polynomial\n pieces used to define the piecewise polynomial in each of the , ,\n and directions ( kx , ky , and kz ). users also may define their own\n knot sequence in , , separately ( tx , ty , and tz ). if iflag=0 ,\n however, db3ink will choose sequences of knots that result in a\n piecewise polynomial interpolant with kx-2 continuous partial\n derivatives in , ky-2 continuous partial derivatives in , and kz-2 continuous partial derivatives in . ( kx knots are taken near\n each endpoint in , not-a-knot end conditions are used, and the\n remaining knots are placed at data points if kx is even or at\n midpoints between data points if kx is odd. the and directions\n are treated similarly.) After a call to db3ink , all information necessary to define the\n interpolating function are contained in the parameters nx , ny , nz , kx , ky , kz , tx , ty , tz , and bcoef . these quantities should not be\n altered until after the last call of the evaluation routine db3val . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should\ncontain the function value at the point ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db3ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db3ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db3ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db3ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:) :: bcoef (nx,ny,nz) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = ty not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 712 = size(tx) nx+kx 713 = size(ty) ny+ky 714 = size(tz) nz+kz 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) Calls proc~~db3ink~~CallsGraph proc~db3ink bspline_sub_module::db3ink proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db3ink~~CalledByGraph proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db3ink ( x , nx , y , ny , z , nz , fcn , kx , ky , kz , iknot , tx , ty , tz , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. `fcn(i,j,k)` should !! contain the function value at the point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db3ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `ty` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1))` integer ( ip ) :: i , j , k , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz ,& kx = kx , ky = ky , kz = kz ,& x = x , y = y , z = z ,& tx = tx , ty = ty , tz = tz ,& f3 = fcn ,& bcoef3 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) end if allocate ( temp ( nx * ny * nz )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp = reshape( fcn, [nx*ny*nz] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k ) end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny , tz , kz , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db3ink","tags":"","loc":"proc/db3ink.html"},{"title":"db3val – bspline-fortran","text":"public pure subroutine db3val(xval, yval, zval, idx, idy, idz, tx, ty, tz, nx, ny, nz, kx, ky, kz, bcoef, f, iflag, inbvx, inbvy, inbvz, iloy, iloz, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db3ink or one of its\n derivatives at the point ( xval , yval , zval ). To evaluate the\n interpolant itself, set idx=idy=idz=0 , to evaluate the first\n partial with respect to x , set idx=1 , idy=idz=0 , and so on. db3val returns 0.0 if ( xval , yval , zval ) is out of range. that is, xval < tx ( 1 ) . or . xval > tx ( nx + kx ) . or . yval < ty ( 1 ) . or . yval > ty ( ny + ky ) . or . zval < tz ( 1 ) . or . zval > tz ( nz + kz ) if the knots tx , ty , and tz were chosen by db3ink , then this is\n equivalent to xval < x ( 1 ) . or . xval > x ( nx ) + epsx . or . yval < y ( 1 ) . or . yval > y ( ny ) + epsy . or . zval < z ( 1 ) . or . zval > z ( nz ) + epsz where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) epsy = 0.1 * ( y ( ny ) - y ( ny - 1 )) epsz = 0.1 * ( z ( nz ) - z ( nz - 1 )) The input quantities tx , ty , tz , nx , ny , nz , kx , ky , kz , and bcoef should remain unchanged since the last call of db3ink . History Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. JEC : 000330 modified array declarations. Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nx,ny,nz) :: bcoef the b-spline coefficients computed by db3ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz) :: w2 work array real(kind=wp), intent(inout), dimension(kz) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db3val~~CallsGraph proc~db3val bspline_sub_module::db3val proc~check_value bspline_sub_module::check_value proc~db3val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db3val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db3val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db3val~~CalledByGraph proc~db3val bspline_sub_module::db3val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db3val ( xval , yval , zval , idx , idy , idz ,& tx , ty , tz ,& nx , ny , nz , kx , ky , kz , bcoef , f , iflag ,& inbvx , inbvy , inbvz , iloy , iloz , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nx , ny , nz ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db3ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kz ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , kcoly , kcolz , j , k f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz ), nx , kx , idx , xval , inbvx , w0 , iflag , w2 ( j , k ), extrap ) if ( iflag /= 0_ip ) return end do end do kcoly = lefty - ky + 1_ip do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w2 (:, k ), ky , ky , idy , yval , inbvy , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return end do kcolz = leftz - kz + 1_ip call dbvalu ( tz ( kcolz :), w1 , kz , kz , idz , zval , inbvz , w0 , iflag , f , extrap ) end subroutine db3val","tags":"","loc":"proc/db3val.html"},{"title":"db4ink – bspline-fortran","text":"public pure subroutine db4ink(x, nx, y, ny, z, nz, q, nq, fcn, kx, ky, kz, kq, iknot, tx, ty, tz, tq, bcoef, iflag) Determines the parameters of a function that interpolates\n the four-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db4val . See db3ink header for more details. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,q) should contain the function value at the\n point ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db4ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the x direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the y direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the z direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the q direction for the spline\ninterpolant. If iknot=0 these are chosen by db4ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:,:) :: bcoef (nx,ny,nz,nq) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = tz not non-decreasing. 15 = nq out of range. 16 = kq out of range. 17 = q not strictly increasing. 18 = tq not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 703 = size(q) size(fcn,4) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 709 = size(q) nq 712 = size(tx ) nx+kx 713 = size(ty ) ny+ky 714 = size(tz ) nz+kz 715 = size(tq ) nq+kq 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) 803 = size(q) size(bcoef,4) Calls proc~~db4ink~~CallsGraph proc~db4ink bspline_sub_module::db4ink proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db4ink~~CalledByGraph proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& tx , ty , tz , tq ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,q)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db4ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 712 = `size(tx`) \\ne `nx+kx` !! * 713 = `size(ty`) \\ne `ny+ky` !! * 714 = `size(tz`) \\ne `nz+kz` !! * 715 = `size(tq`) \\ne `nq+kq` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of dimension `nx*ny*nz*nq` real ( wp ), dimension (:), allocatable :: work !! work array of dimension `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq ,& kx = kx , ky = ky , kz = kz , kq = kq ,& x = x , y = y , z = z , q = q ,& tx = tx , ty = ty , tz = tz , tq = tq ,& f4 = fcn ,& bcoef4 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) end if allocate ( temp ( nx * ny * nz * nq )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz , tq , kq , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db4ink","tags":"","loc":"proc/db4ink.html"},{"title":"db4val – bspline-fortran","text":"public pure subroutine db4val(xval, yval, zval, qval, idx, idy, idz, idq, tx, ty, tz, tq, nx, ny, nz, nq, kx, ky, kz, kq, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, iloy, iloz, iloq, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db4ink or one of its\n derivatives at the point ( xval , yval , zval , qval ). To evaluate the\n interpolant itself, set idx=idy=idz=idq=0 , to evaluate the first\n partial with respect to x , set idx=1,idy=idz=idq=0 , and so on. See db3val header for more information. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq) :: bcoef the b-spline coefficients computed by db4ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq) :: w3 work array real(kind=wp), intent(inout), dimension(kz,kq) :: w2 work array real(kind=wp), intent(inout), dimension(kq) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db4val~~CallsGraph proc~db4val bspline_sub_module::db4val proc~check_value bspline_sub_module::check_value proc~db4val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db4val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db4val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db4val~~CalledByGraph proc~db4val bspline_sub_module::db4val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& tx , ty , tz , tq ,& nx , ny , nz , nq ,& kx , ky , kz , kq ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq ,& iloy , iloz , iloq , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db4ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nx , ny , nz , nq ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db4ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kz , kq ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kq ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , & kcoly , kcolz , kcolq , j , k , q f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w3 ( j , k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! y -> z, q kcoly = lefty - ky + 1_ip do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w3 (:, k , q ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w2 ( k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do ! z -> q kcolz = leftz - kz + 1_ip do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w2 (:, q ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w1 ( q ), extrap ) if ( iflag /= 0_ip ) return end do ! q kcolq = leftq - kq + 1_ip call dbvalu ( tq ( kcolq :), w1 , kq , kq , idq , qval , inbvq , w0 , iflag , f , extrap ) end subroutine db4val","tags":"","loc":"proc/db4val.html"},{"title":"db5ink – bspline-fortran","text":"public pure subroutine db5ink(x, nx, y, ny, z, nz, q, nq, r, nr, fcn, kx, ky, kz, kq, kr, iknot, tx, ty, tz, tq, tr, bcoef, iflag) Determines the parameters of a function that interpolates\n the five-dimensional gridded data: for: The interpolating function and its derivatives may subsequently be evaluated\n by the function db5val . See db3ink header for more details. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,q,r) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db5ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the spline\ninterpolant. If iknot=0 these are chosen by db5ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = tz not non-decreasing. 15 = nq out of range. 16 = kq out of range. 17 = q not strictly increasing. 18 = tq not non-decreasing. 19 = nr out of range. 20 = kr out of range. 21 = r not strictly increasing. 22 = tr not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 703 = size(q) size(fcn,4) 704 = size(r) size(fcn,5) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 709 = size(q) nq 710 = size(r) nr 712 = size(tx) nx+kx 713 = size(ty) ny+ky 714 = size(tz) nz+kz 715 = size(tq) nq+kq 716 = size(tr) nr+kr 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) 803 = size(q) size(bcoef,4) 804 = size(r) size(bcoef,5) Calls proc~~db5ink~~CallsGraph proc~db5ink bspline_sub_module::db5ink proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db5ink~~CalledByGraph proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& tx , ty , tz , tq , tr ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,q,r)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db5ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 704 = `size(r)` \\ne `size(fcn,5)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 710 = `size(r)` \\ne `nr` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` !! * 804 = `size(r)` \\ne `size(bcoef,5)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz*nq*nr` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1),2*kr*(nr+1))` integer ( ip ) :: i , j , k , l , m , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr ,& x = x , y = y , z = z , q = q , r = r ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr ,& f5 = fcn ,& bcoef5 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) end if allocate ( temp ( nx * ny * nz * nq * nr )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ), 2_ip * kr * ( nr + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp(1:nx*ny*nz*nq*nr) = reshape( fcn, [nx*ny*nz*nq*nr] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do m = 1_ip , nr do l = 1_ip , nq do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k , l , m ) end do end do end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz * nq * nr , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz * nq * nr , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny * nq * nr , tz , kz , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , bcoef , nq , nx * ny * nz * nr , tq , kq , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , temp , nr , nx * ny * nz * nq , tr , kr , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db5ink","tags":"","loc":"proc/db5ink.html"},{"title":"db5val – bspline-fortran","text":"public pure subroutine db5val(xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, tx, ty, tz, tq, tr, nx, ny, nz, nq, nr, kx, ky, kz, kq, kr, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, iloy, iloz, iloq, ilor, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db5ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval ). To evaluate the\n interpolant itself, set idx=idy=idz=idq=idr=0 , to evaluate the first\n partial with respect to x , set idx=1,idy=idz=idq=idr=0, and so on. See db3val header for more information. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr) :: bcoef the b-spline coefficients computed by db5ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr) :: w4 work array real(kind=wp), intent(inout), dimension(kz,kq,kr) :: w3 work array real(kind=wp), intent(inout), dimension(kq,kr) :: w2 work array real(kind=wp), intent(inout), dimension(kr) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db5val~~CallsGraph proc~db5val bspline_sub_module::db5val proc~check_value bspline_sub_module::check_value proc~db5val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db5val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db5val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db5val~~CalledByGraph proc~db5val bspline_sub_module::db5val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& tx , ty , tz , tq , tr ,& nx , ny , nz , nq , nr ,& kx , ky , kz , kq , kr ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr ,& iloy , iloz , iloq , ilor ,& w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db5ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db5ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kz , kq , kr ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kq , kr ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kr ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , & kcoly , kcolz , kcolq , kcolr , j , k , q , r f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr ),& nx , kx , idx , xval , inbvx , w0 , iflag , w4 ( j , k , q , r ),& extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! y -> z, q, r kcoly = lefty - ky + 1_ip do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w4 (:, k , q , r ), ky , ky , idy , yval , inbvy ,& w0 , iflag , w3 ( k , q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! z -> q, r kcolz = leftz - kz + 1_ip do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w3 (:, q , r ), kz , kz , idz , zval , inbvz ,& w0 , iflag , w2 ( q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do ! q -> r kcolq = leftq - kq + 1_ip do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w2 (:, r ), kq , kq , idq , qval , inbvq ,& w0 , iflag , w1 ( r ), extrap ) if ( iflag /= 0_ip ) return end do ! r kcolr = leftr - kr + 1_ip call dbvalu ( tr ( kcolr :), w1 , kr , kr , idr , rval , inbvr , w0 , iflag , f , extrap ) end subroutine db5val","tags":"","loc":"proc/db5val.html"},{"title":"db6ink – bspline-fortran","text":"public pure subroutine db6ink(x, nx, y, ny, z, nz, q, nq, r, nr, s, ns, fcn, kx, ky, kz, kq, kr, ks, iknot, tx, ty, tz, tq, tr, ts, bcoef, iflag) Determines the parameters of a function that interpolates\n the six-dimensional gridded data: for: the interpolating function and its derivatives may subsequently be evaluated\n by the function db6val . See db3ink header for more details. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ns number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to\ninterpolate. fcn(i,j,k,q,r,s) should contain the\nfunction value at the point\n( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: 0 = knot sequence chosen by db6ink . 1 = knot sequence chosen by user. real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the\nspline interpolant. f iknot=0 these are chosen by db6ink . f iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(inout), dimension(:) :: ts The (ns+ks) knots in the direction for the\nspline interpolant. If iknot=0 these are chosen by db6ink . If iknot=1 these are specified by the user. Must be non-decreasing. real(kind=wp), intent(out), dimension(:,:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr,ns) matrix of coefficients of the\nb-spline interpolant. integer(kind=ip), intent(out) :: iflag 0 = successful execution. 2 = iknot out of range. 3 = nx out of range. 4 = kx out of range. 5 = x not strictly increasing. 6 = tx not non-decreasing. 7 = ny out of range. 8 = ky out of range. 9 = y not strictly increasing. 10 = ty not non-decreasing. 11 = nz out of range. 12 = kz out of range. 13 = z not strictly increasing. 14 = tz not non-decreasing. 15 = nq out of range. 16 = kq out of range. 17 = q not strictly increasing. 18 = tq not non-decreasing. 19 = nr out of range. 20 = kr out of range. 21 = r not strictly increasing. 22 = tr not non-decreasing. 23 = ns out of range. 24 = ks out of range. 25 = s not strictly increasing. 26 = ts not non-decreasing. 700 = size(x) size(fcn,1) 701 = size(y) size(fcn,2) 702 = size(z) size(fcn,3) 703 = size(q) size(fcn,4) 704 = size(r) size(fcn,5) 705 = size(s) size(fcn,6) 706 = size(x) nx 707 = size(y) ny 708 = size(z) nz 709 = size(q) nq 710 = size(r) nr 711 = size(s) ns 712 = size(tx) nx+kx 713 = size(ty) ny+ky 714 = size(tz) nz+kz 715 = size(tq) nq+kq 716 = size(tr) nr+kr 717 = size(ts) ns+ks 800 = size(x) size(bcoef,1) 801 = size(y) size(bcoef,2) 802 = size(z) size(bcoef,3) 803 = size(q) size(bcoef,4) 804 = size(r) size(bcoef,5) 805 = size(s) size(bcoef,6) Calls proc~~db6ink~~CallsGraph proc~db6ink bspline_sub_module::db6ink proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db6ink~~CalledByGraph proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& tx , ty , tz , tq , tr , ts ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ns !! number of s abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! the order of spline pieces in s !! ( 2 \\le k_s < n_s ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. !! must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to !! interpolate. `fcn(i,j,k,q,r,s)` should contain the !! function value at the point !! (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db6ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the !! spline interpolant. !! !! * f `iknot=0` these are chosen by [[db6ink]]. !! * f `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ts !! The `(ns+ks)` knots in the s direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr,ns)` matrix of coefficients of the !! b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 23 = `ns` out of range. !! * 24 = `ks` out of range. !! * 25 = `s` not strictly increasing. !! * 26 = `ts` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 703 = `size(q) ` \\ne `size(fcn,4)` !! * 704 = `size(r) ` \\ne `size(fcn,5)` !! * 705 = `size(s) ` \\ne `size(fcn,6)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 709 = `size(q) ` \\ne `nq` !! * 710 = `size(r) ` \\ne `nr` !! * 711 = `size(s) ` \\ne `ns` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 717 = `size(ts)` \\ne `ns+ks` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` !! * 803 = `size(q) ` \\ne `size(bcoef,4)` !! * 804 = `size(r) ` \\ne `size(bcoef,5)` !! * 805 = `size(s) ` \\ne `size(bcoef,6)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of size `nx*ny*nz*nq*nr*ns` real ( wp ), dimension (:), allocatable :: work !! work array of size `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1), !! 2*kr*(nr+1),2*ks*(ns+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr , ns = ns ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr , ks = ks ,& x = x , y = y , z = z , q = q , r = r , s = s ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr , ts = ts ,& f6 = fcn ,& bcoef6 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) call dbknot ( s , ns , ks , ts ) end if allocate ( temp ( nx * ny * nz * nq * nr * ns )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ),& 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ),& 2_ip * kr * ( nr + 1_ip ), 2_ip * ks * ( ns + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq * nr * ns , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq * nr * ns , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq * nr * ns , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz * nr * ns , tq , kq , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , bcoef , nr , nx * ny * nz * nq * ns , tr , kr , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( s , ns , temp , ns , nx * ny * nz * nq * nr , ts , ks , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db6ink","tags":"","loc":"proc/db6ink.html"},{"title":"db6val – bspline-fortran","text":"public pure subroutine db6val(xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, tx, ty, tz, tq, tr, ts, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, inbvs, iloy, iloz, iloq, ilor, ilos, w5, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db6ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval , sval ). To evaluate the\n interpolant itself, set idx=idy=idz=idq=idr=ids=0 , to evaluate the first\n partial with respect to x , set idx=1,idy=idz=idq=idr=ids=0 , and so on. See db3val header for more information. History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ns+ks) :: ts sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ns the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ks order of polynomial pieces in .\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr,ns) :: bcoef the b-spline coefficients computed by db6ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: : no errors : error integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvs initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilos initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr,ks) :: w5 work array real(kind=wp), intent(inout), dimension(kz,kq,kr,ks) :: w4 work array real(kind=wp), intent(inout), dimension(kq,kr,ks) :: w3 work array real(kind=wp), intent(inout), dimension(kr,ks) :: w2 work array real(kind=wp), intent(inout), dimension(ks) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr,ks)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~db6val~~CallsGraph proc~db6val bspline_sub_module::db6val proc~check_value bspline_sub_module::check_value proc~db6val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db6val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db6val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~db6val~~CalledByGraph proc~db6val bspline_sub_module::db6val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& tx , ty , tz , tq , tr , ts ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr , inbvs ,& iloy , iloz , iloq , ilor , ilos ,& w5 , w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ns !! the number of interpolation points in s. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ks !! order of polynomial pieces in s. !! (same as in last call to [[db6ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ns + ks ), intent ( in ) :: ts !! sequence of knots defining the piecewise polynomial !! in the s direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr , ns ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db6ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvs !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilos !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr , ks ), intent ( inout ) :: w5 !! work array real ( wp ), dimension ( kz , kq , kr , ks ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kq , kr , ks ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kr , ks ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( ks ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr , ks )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , lefts ,& kcoly , kcolz , kcolq , kcolr , kcols ,& j , k , q , r , s f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( sval , ts , 6_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ts , ns + ks , sval , ilos , lefts , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r, s kcols = lefts - ks do s = 1_ip , ks kcols = kcols + 1_ip kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr , kcols ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w5 ( j , k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do end do ! y -> z, q, r, s kcoly = lefty - ky + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w5 (:, k , q , r , s ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w4 ( k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! z -> q, r, s kcolz = leftz - kz + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w4 (:, q , r , s ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w3 ( q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! q -> r, s kcolq = leftq - kq + 1_ip do s = 1_ip , ks do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w3 (:, r , s ),& kq , kq , idq , qval , inbvq , w0 , iflag ,& w2 ( r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do ! r -> s kcolr = leftr - kr + 1_ip do s = 1_ip , ks call dbvalu ( tr ( kcolr :), w2 (:, s ),& kr , kr , idr , rval , inbvr , w0 , iflag ,& w1 ( s ), extrap ) if ( iflag /= 0_ip ) return end do ! s kcols = lefts - ks + 1_ip call dbvalu ( ts ( kcols :), w1 , ks , ks , ids , sval , inbvs , w0 , iflag , f , extrap ) end subroutine db6val","tags":"","loc":"proc/db6val.html"},{"title":"check_inputs – bspline-fortran","text":"private pure subroutine check_inputs(iknot, iflag, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, x, y, z, q, r, s, tx, ty, tz, tq, tr, ts, f1, f2, f3, f4, f5, f6, bcoef1, bcoef2, bcoef3, bcoef4, bcoef5, bcoef6, alt, status_ok) Check the validity of the inputs to the db*ink routines.\n Prints warning message if there is an error,\n and also sets iflag and status_ok. Supports up to 6D: x , y , z , q , r , s Notes The code is new, but the logic is based on the original\n logic in the CMLIB routines db2ink and db3ink . History Jacob Williams, 2/24/2015 : Created this routine. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iknot = 0 if the INK routine is computing the knots. integer(kind=ip), intent(out) :: iflag integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: x real(kind=wp), intent(in), optional, dimension(:) :: y real(kind=wp), intent(in), optional, dimension(:) :: z real(kind=wp), intent(in), optional, dimension(:) :: q real(kind=wp), intent(in), optional, dimension(:) :: r real(kind=wp), intent(in), optional, dimension(:) :: s real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts real(kind=wp), intent(in), optional, dimension(:) :: f1 real(kind=wp), intent(in), optional, dimension(:,:) :: f2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: f3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: f4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: f5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: f6 real(kind=wp), intent(in), optional, dimension(:) :: bcoef1 real(kind=wp), intent(in), optional, dimension(:,:) :: bcoef2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: bcoef3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: bcoef4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: bcoef5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: bcoef6 logical, intent(in), optional :: alt using the alt routine where 1st or\n2nd deriv is fixed at endpoints\n[default is False] logical, intent(out) :: status_ok Called by proc~~check_inputs~~CalledByGraph proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~check_inputs proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~check_inputs proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~check_inputs proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~check_inputs proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~check_inputs proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~check_inputs proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~check_inputs interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine check_inputs ( iknot ,& iflag ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& x , y , z , q , r , s ,& tx , ty , tz , tq , tr , ts ,& f1 , f2 , f3 , f4 , f5 , f6 ,& bcoef1 , bcoef2 , bcoef3 , bcoef4 , bcoef5 , bcoef6 ,& alt ,& status_ok ) implicit none integer ( ip ), intent ( in ) :: iknot !! = 0 if the `INK` routine is computing the knots. integer ( ip ), intent ( out ) :: iflag integer ( ip ), intent ( in ), optional :: nx , ny , nz , nq , nr , ns integer ( ip ), intent ( in ), optional :: kx , ky , kz , kq , kr , ks real ( wp ), dimension (:), intent ( in ), optional :: x , y , z , q , r , s real ( wp ), dimension (:), intent ( in ), optional :: tx , ty , tz , tq , tr , ts real ( wp ), dimension (:), intent ( in ), optional :: f1 , bcoef1 real ( wp ), dimension (:,:), intent ( in ), optional :: f2 , bcoef2 real ( wp ), dimension (:,:,:), intent ( in ), optional :: f3 , bcoef3 real ( wp ), dimension (:,:,:,:), intent ( in ), optional :: f4 , bcoef4 real ( wp ), dimension (:,:,:,:,:), intent ( in ), optional :: f5 , bcoef5 real ( wp ), dimension (:,:,:,:,:,:), intent ( in ), optional :: f6 , bcoef6 logical , intent ( in ), optional :: alt !! using the alt routine where 1st or !! 2nd deriv is fixed at endpoints !! [default is False] logical , intent ( out ) :: status_ok logical :: error integer :: iex !! extra points for the alt case (in `t` and `bcoef`) !! [currently, only allowed for the 1D case & `k=4`] status_ok = . false . iex = 0_ip ! default if ( present ( alt )) then if ( alt ) iex = 2_ip ! for \"alt\" mode end if if (( iknot < 0_ip ) . or . ( iknot > 1_ip )) then iflag = 2_ip ! iknot is out of range else call check ( 'x' , nx , kx , x , tx ,[ 3_ip , 4_ip , 5_ip , 6_ip , 706_ip , 712_ip ], iflag , error , iex ); if ( error ) return call check ( 'y' , ny , ky , y , ty ,[ 7_ip , 8_ip , 9_ip , 10_ip , 707_ip , 713_ip ], iflag , error , iex ); if ( error ) return call check ( 'z' , nz , kz , z , tz ,[ 11_ip , 12_ip , 13_ip , 14_ip , 708_ip , 714_ip ], iflag , error , iex ); if ( error ) return call check ( 'q' , nq , kq , q , tq ,[ 15_ip , 16_ip , 17_ip , 18_ip , 709_ip , 715_ip ], iflag , error , iex ); if ( error ) return call check ( 'r' , nr , kr , r , tr ,[ 19_ip , 20_ip , 21_ip , 22_ip , 710_ip , 716_ip ], iflag , error , iex ); if ( error ) return call check ( 's' , ns , ks , s , ts ,[ 23_ip , 24_ip , 25_ip , 26_ip , 711_ip , 717_ip ], iflag , error , iex ); if ( error ) return if ( present ( x ) . and . present ( f1 ) . and . present ( bcoef1 )) then if ( size ( x , kind = ip ) /= size ( f1 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef1 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( f2 ) . and . present ( bcoef2 )) then if ( size ( x , kind = ip ) /= size ( f2 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f2 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef2 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef2 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( f3 ) . and . & present ( bcoef3 )) then if ( size ( x , kind = ip ) /= size ( f3 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f3 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f3 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef3 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef3 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef3 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( f4 ) . and . present ( bcoef4 )) then if ( size ( x , kind = ip ) /= size ( f4 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f4 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f4 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f4 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef4 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef4 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef4 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef4 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( f5 ) . and . present ( bcoef5 )) then if ( size ( x , kind = ip ) /= size ( f5 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f5 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f5 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f5 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f5 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef5 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef5 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef5 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef5 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef5 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( s ) . and . present ( f6 ) . and . present ( bcoef6 )) then if ( size ( x , kind = ip ) /= size ( f6 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f6 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f6 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f6 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f6 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( s , kind = ip ) /= size ( f6 , 6_ip , kind = ip )) then ; iflag = 705_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef6 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef6 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef6 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef6 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef6 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if if ( size ( s , kind = ip ) + iex /= size ( bcoef6 , 6_ip , kind = ip )) then ; iflag = 805_ip ; return ; end if end if status_ok = . true . iflag = 0_ip end if contains pure subroutine check ( s , n , k , x , t , ierrs , iflag , error , ik ) !! check `t`,`x`,`n`,`k` for validity implicit none character ( len = 1 ), intent ( in ) :: s !! coordinate string: 'x','y','z','q','r','s' integer ( ip ), intent ( in ), optional :: n !! size of `x` integer ( ip ), intent ( in ), optional :: k !! order real ( wp ), dimension (:), intent ( in ), optional :: x !! abcissae vector real ( wp ), dimension (:), intent ( in ), optional :: t !! knot vector `size(n+k)` integer ( ip ), dimension (:), intent ( in ) :: ierrs !! int error codes for `n`,`k`,`x`,`t`, !! `size(x)`,`size(t)` checks integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error !! true if there was an error integer , intent ( in ) :: ik !! add this value to k integer ( ip ), dimension ( 2 ) :: itmp !! temp integer array if ( present ( n ) . and . present ( k ) . and . present ( x ) . and . present ( t )) then itmp = [ ierrs ( 1_ip ), ierrs ( 5 )] call check_n ( 'n' // s , n , x , itmp , iflag , error ); if ( error ) return call check_k ( 'k' // s , k + ik , n , ierrs ( 2 ), iflag , error ); if ( error ) return call check_x ( s , n , x , ierrs ( 3 ), iflag , error ); if ( error ) return if ( iknot /= 0_ip ) then itmp = [ ierrs ( 4 ), ierrs ( 6 )] call check_t ( 't' // s , n , k + ik , t , itmp , iflag , error ); if ( error ) return end if end if end subroutine check pure subroutine check_n ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x !! abcissae vector integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [n<3 check, size(x)==n check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if ( n < 3_ip ) then iflag = ierr ( 1_ip ) error = . true . else if ( size ( x ) /= n ) then iflag = ierr ( 2 ) error = . true . else error = . false . end if end if end subroutine check_n pure subroutine check_k ( s , k , n , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: k integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if (( k < 2_ip ) . or . ( k >= n )) then iflag = ierr error = . true . else error = . false . end if end subroutine check_k pure subroutine check_x ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . do i = 2_ip , n if ( x ( i ) <= x ( i - 1_ip )) then iflag = ierr return end if end do error = . false . end subroutine check_x pure subroutine check_t ( s , n , k , t , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: t integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [non-decreasing check, size check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . if ( size ( t ) /= ( n + k )) then iflag = ierr ( 2 ) return end if if ( iex == 0_ip ) then ! don't do this for \"alt\" mode since they haven't been computed yet do i = 2_ip , n + k if ( t ( i ) < t ( i - 1_ip )) then iflag = ierr ( 1_ip ) return end if end do end if error = . false . end subroutine check_t end subroutine check_inputs","tags":"","loc":"proc/check_inputs.html"},{"title":"dbknot – bspline-fortran","text":"private pure subroutine dbknot(x, n, k, t) dbknot chooses a knot sequence for interpolation of order k at the\n data points x(i), i=1,..,n. the n+k knots are placed in the array\n t. k knots are placed at each endpoint and not-a-knot end\n conditions are used. the remaining knots are placed at data points\n if n is even and between data points if n is odd. the rightmost\n knot is shifted slightly to the right to insure proper interpolation\n at x(n) (see page 350 of the reference). History Jacob Williams, 2/24/2015 : Refactored this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(:) :: t Called by proc~~dbknot~~CalledByGraph proc~dbknot bspline_sub_module::dbknot proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbknot proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbknot proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbknot proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbknot proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbknot proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbknot interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbknot ( x , n , k , t ) implicit none integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension (:), intent ( out ) :: t integer ( ip ) :: i , j , ipj , npj , ip1 , jstrt real ( wp ) :: rnot !put k knots at each endpoint !(shift right endpoints slightly -- see pg 350 of reference) rnot = x ( n ) + 0.1_wp * ( x ( n ) - x ( n - 1_ip ) ) do j = 1_ip , k t ( j ) = x ( 1_ip ) npj = n + j t ( npj ) = rnot end do !distribute remaining knots if ( mod ( k , 2_ip ) == 1_ip ) then !case of odd k -- knots between data points i = ( k - 1_ip ) / 2_ip - k ip1 = i + 1_ip jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = 0.5_wp * ( x ( ipj ) + x ( ipj + 1_ip ) ) end do else !case of even k -- knots at data points i = ( k / 2_ip ) - k jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = x ( ipj ) end do end if end subroutine dbknot","tags":"","loc":"proc/dbknot.html"},{"title":"dbtpcf – bspline-fortran","text":"private pure subroutine dbtpcf(x, n, fcn, ldf, nf, t, k, bcoef, work, iflag) dbtpcf computes b-spline interpolation coefficients for nf sets\n of data stored in the columns of the array fcn. the b-spline\n coefficients are stored in the rows of bcoef however.\n each interpolation is based on the n abcissa stored in the\n array x, and the n+k knots stored in the array t. the order\n of each interpolation is k. History Jacob Williams, 2/24/2015 : Refactored this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x real(kind=wp), intent(in), dimension(ldf,nf) :: fcn integer(kind=ip), intent(in) :: ldf integer(kind=ip), intent(in) :: nf real(kind=wp), intent(in), dimension(:) :: t integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(nf,n) :: bcoef real(kind=wp), intent(out), dimension(*) :: work work array of size >= 2*k*(n+1) integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 301: n should be >0 Calls proc~~dbtpcf~~CallsGraph proc~dbtpcf bspline_sub_module::dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbtpcf~~CalledByGraph proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbtpcf ( x , n , fcn , ldf , nf , t , k , bcoef , work , iflag ) integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: nf integer ( ip ), intent ( in ) :: ldf integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension ( ldf , nf ), intent ( in ) :: fcn real ( wp ), dimension (:), intent ( in ) :: t real ( wp ), dimension ( nf , n ), intent ( out ) :: bcoef real ( wp ), dimension ( * ), intent ( out ) :: work !! work array of size >= `2*k*(n+1)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 301: n should be >0 integer ( ip ) :: i , j , m1 , m2 , iq , iw ! check for null input if ( nf > 0_ip ) then ! partition work array m1 = k - 1_ip m2 = m1 + k iq = 1_ip + n iw = iq + m2 * n + 1_ip ! compute b-spline coefficients ! first data set call dbintk ( x , fcn , t , n , k , work , work ( iq ), work ( iw ), iflag ) if ( iflag == 0_ip ) then do i = 1_ip , n bcoef ( 1_ip , i ) = work ( i ) end do ! all remaining data sets by back-substitution if ( nf == 1_ip ) return do j = 2_ip , nf do i = 1_ip , n work ( i ) = fcn ( i , j ) end do call dbnslv ( work ( iq ), m2 , n , m1 , m1 , work ) do i = 1_ip , n bcoef ( j , i ) = work ( i ) end do end do end if else !write(error_unit,'(A)') 'dbtpcf - n should be >0' iflag = 301_ip end if end subroutine dbtpcf","tags":"","loc":"proc/dbtpcf.html"},{"title":"dbintk – bspline-fortran","text":"private pure subroutine dbintk(x, y, t, n, k, bcoef, q, work, iflag) dbintk produces the b-spline coefficients, bcoef, of the\n b-spline of order k with knots t(i), i=1,...,n+k, which\n takes on the value y(i) at x(i), i=1,...,n. the spline or\n any of its derivatives can be evaluated by calls to dbvalu . the i-th equation of the linear system a*bcoef = b for the\n coefficients of the interpolant enforces interpolation at\n x(i), i=1,...,n. hence, b(i) = y(i), for all i, and a is\n a band matrix with 2k-1 bands if a is invertible. the matrix\n a is generated row by row and stored, diagonal by diagonal,\n in the rows of q, with the main diagonal going into row k.\n the banded system is then solved by a call to dbnfac (which\n constructs the triangular factorization for a and stores it\n again in q), followed by a call to dbnslv (which then\n obtains the solution bcoef by substitution). dbnfac does no\n pivoting, since the total positivity of the matrix a makes\n this unnecessary. the linear system to be solved is\n (theoretically) invertible if and only if\n t(i) < x(i) < t(i+k), for all i.\n equality is permitted on the left for i=1 and on the right\n for i=n when k knots are used at x(1) or x(n). otherwise,\n violation of this condition is certain to lead to an error. Error conditions improper input singular system of equations History splint written by carl de boor [5] dbintk author: amos, d. e., (snla) : date written 800901 revision date 820801 000330 modified array declarations. (jec) Jacob Williams, 5/10/2015 : converted to free-form Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(n) :: x vector of length n containing data point abscissa\nin strictly increasing order. real(kind=wp), intent(in), dimension(n) :: y corresponding vector of length n containing data\npoint ordinates. real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k\nsince t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) = x(n), this leaves only n-k knots (not\nnecessarily x(i) values) interior to (x(1),x(n)) integer(kind=ip), intent(in) :: n number of data points, n >= k integer(kind=ip), intent(in) :: k order of the spline, k >= 1 real(kind=wp), intent(out), dimension(n) :: bcoef a vector of length n containing the b-spline coefficients real(kind=wp), intent(out), dimension(*) :: q a work vector of length (2 k-1) n, containing\nthe triangular factorization of the coefficient\nmatrix of the linear system being solved. the\ncoefficients for the interpolant of an\nadditional data set (x(i),yy(i)), i=1,...,n\nwith the same abscissa can be obtained by loading\nyy into bcoef and then executing\ncall dbnslv(q,2k-1,n,k-1,k-1,bcoef) real(kind=wp), intent(out), dimension(*) :: work work vector of length 2*k integer(kind=ip), intent(out) :: iflag 0: no errors. 100: k does not satisfy k>=1. 101: n does not satisfy n>=k. 102: x(i) does not satisfy x(i)proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbintk~~CalledByGraph proc~dbintk bspline_sub_module::dbintk proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbintk ( x , y , t , n , k , bcoef , q , work , iflag ) implicit none integer ( ip ), intent ( in ) :: n !! number of data points, n >= k real ( wp ), dimension ( n ), intent ( in ) :: x !! vector of length n containing data point abscissa !! in strictly increasing order. real ( wp ), dimension ( n ), intent ( in ) :: y !! corresponding vector of length n containing data !! point ordinates. real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length n+k !! since t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) !! >= x(n), this leaves only n-k knots (not !! necessarily x(i) values) interior to (x(1),x(n)) integer ( ip ), intent ( in ) :: k !! order of the spline, k >= 1 real ( wp ), dimension ( n ), intent ( out ) :: bcoef !! a vector of length n containing the b-spline coefficients real ( wp ), dimension ( * ), intent ( out ) :: q !! a work vector of length (2*k-1)*n, containing !! the triangular factorization of the coefficient !! matrix of the linear system being solved. the !! coefficients for the interpolant of an !! additional data set (x(i),yy(i)), i=1,...,n !! with the same abscissa can be obtained by loading !! yy into bcoef and then executing !! call dbnslv(q,2k-1,n,k-1,k-1,bcoef) real ( wp ), dimension ( * ), intent ( out ) :: work !! work vector of length 2*k integer ( ip ), intent ( out ) :: iflag !! * 0: no errors. !! * 100: k does not satisfy k>=1. !! * 101: n does not satisfy n>=k. !! * 102: x(i) does not satisfy x(i)=1' iflag = 100_ip return end if if ( n < k ) then !write(error_unit,'(A)') 'dbintk - n does not satisfy n>=k' iflag = 101_ip return end if jj = n - 1_ip if ( jj /= 0_ip ) then do i = 1_ip , jj if ( x ( i ) >= x ( i + 1_ip )) then !write(error_unit,'(A)') 'dbintk - x(i) does not satisfy x(i)= ilp1mx ) exit end do if (. not . found ) then left = left - 1_ip if ( xi > t ( left + 1_ip )) then !write(error_unit,'(A)') 'dbintk - some abscissa was not in the support of the'//& ! ' corresponding basis function and the system is singular' iflag = 103_ip return end if end if ! the i-th equation enforces interpolation at xi, hence ! a(i,j) = b(j,k,t)(xi), all j. only the k entries with j = ! left-k+1,...,left actually might be nonzero. these k numbers ! are returned, in bcoef (used for temp.storage here), by the ! following call dbspvn ( t , k , k , 1_ip , xi , left , bcoef , work , iwork , iflag ) if ( iflag /= 0_ip ) return ! we therefore want bcoef(j) = b(left-k+j)(xi) to go into ! a(i,left-k+j), i.e., into q(i-(left+j)+2*k,(left+j)-k) since ! a(i+j,j) is to go into q(i+k,j), all i,j, if we consider q ! as a two-dim. array , with 2*k-1 rows (see comments in ! dbnfac). in the present program, we treat q as an equivalent ! one-dimensional array (because of fortran restrictions on ! dimension statements) . we therefore want bcoef(j) to go into ! entry ! i -(left+j) + 2*k + ((left+j) - k-1)*(2*k-1) ! = i-left+1 + (left -k)*(2*k-1) + (2*k-2)*j ! of q. jj = i - left + 1_ip + ( left - k ) * ( k + km1 ) do j = 1_ip , k jj = jj + kpkm2 q ( jj ) = bcoef ( j ) end do end do ! obtain factorization of a, stored again in q. call dbnfac ( q , k + km1 , n , km1 , km1 , iflag ) if ( iflag == 1 ) then !success ! solve a*bcoef = y by backsubstitution do i = 1_ip , n bcoef ( i ) = y ( i ) end do call dbnslv ( q , k + km1 , n , km1 , km1 , bcoef ) iflag = 0_ip else !failure !write(error_unit,'(A)') 'dbintk - the system of solver detects a singular system'//& ! ' although the theoretical conditions for a solution were satisfied' iflag = 104_ip end if end subroutine dbintk","tags":"","loc":"proc/dbintk.html"},{"title":"dbnfac – bspline-fortran","text":"private pure subroutine dbnfac(w, nroww, nrow, nbandl, nbandu, iflag) Returns in w the LU-factorization (without pivoting) of the banded\n matrix a of order nrow with (nbandl + 1 + nbandu) bands or diagonals\n in the work array w . gauss elimination without pivoting is used. the routine is\n intended for use with matrices a which do not require row inter-\n changes during factorization, especially for the totally\n positive matrices which occur in spline calculations.\n the routine should not be used for an arbitrary banded matrix. Work array Input w array of size ( nroww , nrow ) contains the interesting part of a banded matrix a , with the diagonals or bands of a stored in the rows of w , while columns of a correspond to columns of w . this is the storage mode used in linpack and results in efficient innermost loops . explicitly , a has nbandl bands below the diagonal + 1 ( main ) diagonal + nbandu bands above the diagonal and thus , with middle = nbandu + 1 , a ( i + j , j ) is in w ( i + middle , j ) for i =- nbandu ,..., nbandl j = 1 ,..., nrow . for example , the interesting entries of a ( 1 , 2 ) - banded matrix of order 9 would appear in the first 1 + 1 + 2 = 4 rows of w as follows . 13 24 35 46 57 68 79 12 23 34 45 56 67 78 89 11 22 33 44 55 66 77 88 99 21 32 43 54 65 76 87 98 all other entries of w not identified in this way with an en - try of a are never referenced . Output if iflag = 1, then\n w contains the lu-factorization of a into a unit lower triangu-\n lar matrix l and an upper triangular matrix u (both banded)\n and stored in customary fashion over the corresponding entries\n of a . this makes it possible to solve any particular linear\n system a*x = b for x by a\n call dbnslv ( w, nroww, nrow, nbandl, nbandu, b )\n with the solution x contained in b on return . if iflag = 2, then\n one of nrow-1, nbandl,nbandu failed to be nonnegative, or else\n one of the potential pivots was found to be zero indicating\n that a does not have an lu-factorization. this implies that\n a is singular in case it is totally positive . History banfac written by carl de boor [5] dbnfac from CMLIB [1] Jacob Williams, 5/10/2015 : converted to free-form Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout), dimension(nroww,nrow) :: w work array. See header for details. integer(kind=ip), intent(in) :: nroww row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer(kind=ip), intent(in) :: nrow matrix order integer(kind=ip), intent(in) :: nbandl number of bands of a below the main diagonal integer(kind=ip), intent(in) :: nbandu number of bands of a above the main diagonal integer(kind=ip), intent(out) :: iflag indicating success(=1) or failure (=2) Called by proc~~dbnfac~~CalledByGraph proc~dbnfac bspline_sub_module::dbnfac proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbnfac proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbnfac proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbnfac ( w , nroww , nrow , nbandl , nbandu , iflag ) integer ( ip ), intent ( in ) :: nroww !! row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer ( ip ), intent ( in ) :: nrow !! matrix order integer ( ip ), intent ( in ) :: nbandl !! number of bands of a below the main diagonal integer ( ip ), intent ( in ) :: nbandu !! number of bands of a above the main diagonal integer ( ip ), intent ( out ) :: iflag !! indicating success(=1) or failure (=2) real ( wp ), dimension ( nroww , nrow ), intent ( inout ) :: w !! work array. See header for details. integer ( ip ) :: i , ipk , j , jmax , k , kmax , middle , midmk , nrowm1 real ( wp ) :: factor , pivot iflag = 1_ip middle = nbandu + 1_ip ! w(middle,.) contains the main diagonal of a. nrowm1 = nrow - 1_ip if ( nrowm1 < 0_ip ) then iflag = 2_ip return else if ( nrowm1 == 0_ip ) then if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandl <= 0_ip ) then ! a is upper triangular. check that diagonal is nonzero . do i = 1_ip , nrowm1 if ( w ( middle , i ) == 0.0_wp ) then iflag = 2_ip return end if end do if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandu <= 0_ip ) then ! a is lower triangular. check that diagonal is nonzero and ! divide each column by its diagonal. do i = 1_ip , nrowm1 pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do end do return end if ! a is not just a triangular matrix. construct lu factorization do i = 1_ip , nrowm1 ! w(middle,i) is pivot for i-th step . pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if ! jmax is the number of (nonzero) entries in column i ! below the diagonal. jmax = min ( nbandl , nrow - i ) ! divide each entry in column i below diagonal by pivot. do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do ! kmax is the number of (nonzero) entries in row i to ! the right of the diagonal. kmax = min ( nbandu , nrow - i ) ! subtract a(i,i+k)*(i-th column) from (i+k)-th column ! (below row i). do k = 1_ip , kmax ipk = i + k midmk = middle - k factor = w ( midmk , ipk ) do j = 1_ip , jmax w ( midmk + j , ipk ) = w ( midmk + j , ipk ) - w ( middle + j , i ) * factor end do end do end do ! check the last diagonal entry. if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip end subroutine dbnfac","tags":"","loc":"proc/dbnfac.html"},{"title":"dbnslv – bspline-fortran","text":"private pure subroutine dbnslv(w, nroww, nrow, nbandl, nbandu, b) Companion routine to dbnfac . it returns the solution x of the\n linear system a*x = b in place of b, given the lu-factorization\n for a in the work array w from dbnfac. (with , as stored in w), the unit lower triangular system is solved for , and y stored in b. then the\n upper triangular system is solved for x. the calculations\n are so arranged that the innermost loops stay within columns. History banslv written by carl de boor [5] dbnslv from SLATEC library [1] Jacob Williams, 5/10/2015 : converted to free-form Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nroww,nrow) :: w describes the lu-factorization of a banded matrix a of\norder nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nroww describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nrow describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandl describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandu describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . real(kind=wp), intent(inout), dimension(nrow) :: b in : right side of the system to be solved out : the solution x, of order nrow Called by proc~~dbnslv~~CalledByGraph proc~dbnslv bspline_sub_module::dbnslv proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbnslv proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbnslv proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbnslv proc~dbtpcf->proc~dbintk proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbnslv ( w , nroww , nrow , nbandl , nbandu , b ) integer ( ip ), intent ( in ) :: nroww !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nrow !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandl !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandu !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. real ( wp ), dimension ( nroww , nrow ), intent ( in ) :: w !! describes the lu-factorization of a banded matrix a of !! order `nrow` as constructed in [[dbnfac]]. real ( wp ), dimension ( nrow ), intent ( inout ) :: b !! * **in**: right side of the system to be solved !! * **out**: the solution x, of order nrow integer ( ip ) :: i , j , jmax , middle , nrowm1 middle = nbandu + 1_ip if ( nrow /= 1_ip ) then nrowm1 = nrow - 1_ip if ( nbandl /= 0_ip ) then ! forward pass ! for i=1,2,...,nrow-1, subtract right side(i)*(i-th column of l) ! from right side (below i-th row). do i = 1_ip , nrowm1 jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax b ( i + j ) = b ( i + j ) - b ( i ) * w ( middle + j , i ) end do end do end if ! backward pass ! for i=nrow,nrow-1,...,1, divide right side(i) by i-th diagonal ! entry of u, then subtract right side(i)*(i-th column ! of u) from right side (above i-th row). if ( nbandu <= 0_ip ) then ! a is lower triangular. do i = 1_ip , nrow b ( i ) = b ( i ) / w ( 1_ip , i ) end do return end if i = nrow do b ( i ) = b ( i ) / w ( middle , i ) jmax = min ( nbandu , i - 1_ip ) do j = 1_ip , jmax b ( i - j ) = b ( i - j ) - b ( i ) * w ( middle - j , i ) end do i = i - 1_ip if ( i <= 1_ip ) exit end do end if b ( 1_ip ) = b ( 1_ip ) / w ( middle , 1_ip ) end subroutine dbnslv","tags":"","loc":"proc/dbnslv.html"},{"title":"dbspvn – bspline-fortran","text":"private pure subroutine dbspvn(t, jhigh, k, index, x, ileft, vnikx, work, iwork, iflag) Calculates the value of all (possibly) nonzero basis\n functions at x of order max(jhigh,(j+1)*(index-1)), where t(k)\n <= x <= t(n+1) and j=iwork is set inside the routine on\n the first call when index=1. ileft is such that t(ileft) <=\n x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag)\n produces the proper ileft. dbspvn calculates using the basic\n algorithm needed in dbspvd. if only basis functions are\n desired, setting jhigh=k and index=1 can be faster than\n calling dbspvd, but extra coding is required for derivatives\n (index=2) and dbspvd is set up for this purpose. left limiting values are set up as described in dbspvd. Error Conditions improper input History bsplvn written by carl de boor [5] dbspvn author: amos, d. e., (snla) : date written 800901 revision date 820801 000330 modified array declarations. (jec) Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities- k dimension t(ileft+jhigh) integer(kind=ip), intent(in) :: jhigh order of b-spline, 1 <= jhigh <= k integer(kind=ip), intent(in) :: k highest possible order integer(kind=ip), intent(in) :: index index = 1 gives basis functions of order jhigh = 2 denotes previous entry with work , iwork values saved for subsequent calls to\n dbspvn. real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) real(kind=wp), intent(out), dimension(k) :: vnikx vector of length k for spline values. real(kind=wp), intent(inout), dimension(*) :: work a work vector of length 2*k integer(kind=ip), intent(inout) :: iwork a work parameter. both work and iwork contain\ninformation necessary to continue for index = 2 .\nwhen index = 1 exclusively, these are scratch\nvariables and can be used for other purposes. integer(kind=ip), intent(out) :: iflag 0: no errors 201: k does not satisfy k>=1 202: jhigh does not satisfy 1<=jhigh<=k 203: index is not 1 or 2 204: x does not satisfy t(ileft)<=x<=t(ileft+1) Called by proc~~dbspvn~~CalledByGraph proc~dbspvn bspline_sub_module::dbspvn proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbspvn proc~dbspvd bspline_sub_module::dbspvd proc~dbspvd->proc~dbspvn proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbspvd proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbspvn ( t , jhigh , k , index , x , ileft , vnikx , work , iwork , iflag ) implicit none real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-`k` !! dimension `t(ileft+jhigh)` integer ( ip ), intent ( in ) :: jhigh !! order of b-spline, `1 <= jhigh <= k` integer ( ip ), intent ( in ) :: k !! highest possible order integer ( ip ), intent ( in ) :: index !! index = 1 gives basis functions of order `jhigh` !! = 2 denotes previous entry with `work`, `iwork` !! values saved for subsequent calls to !! dbspvn. real ( wp ), intent ( in ) :: x !! argument of basis functions, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that `t(ileft) <= x < t(ileft+1)` real ( wp ), dimension ( k ), intent ( out ) :: vnikx !! vector of length `k` for spline values. real ( wp ), dimension ( * ), intent ( inout ) :: work !! a work vector of length `2*k` integer ( ip ), intent ( inout ) :: iwork !! a work parameter. both `work` and `iwork` contain !! information necessary to continue for `index = 2`. !! when `index = 1` exclusively, these are scratch !! variables and can be used for other purposes. integer ( ip ), intent ( out ) :: iflag !! * 0: no errors !! * 201: `k` does not satisfy `k>=1` !! * 202: `jhigh` does not satisfy `1<=jhigh<=k` !! * 203: `index` is not 1 or 2 !! * 204: `x` does not satisfy `t(ileft)<=x<=t(ileft+1)` integer ( ip ) :: imjp1 , ipj , jp1 , jp1ml , l real ( wp ) :: vm , vmprev ! content of j, deltam, deltap is expected unchanged between calls. ! work(i) = deltap(i), ! work(k+i) = deltam(i), i = 1,k if ( k < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - k does not satisfy k>=1' iflag = 201_ip return end if if ( jhigh > k . or . jhigh < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - jhigh does not satisfy 1<=jhigh<=k' iflag = 202_ip return end if if ( index < 1_ip . or . index > 2_ip ) then !write(error_unit,'(A)') 'dbspvn - index is not 1 or 2' iflag = 203_ip return end if if ( x < t ( ileft ) . or . x > t ( ileft + 1_ip )) then !write(error_unit,'(A)') 'dbspvn - x does not satisfy t(ileft)<=x<=t(ileft+1)' iflag = 204_ip return end if iflag = 0_ip if ( index == 1_ip ) then iwork = 1_ip vnikx ( 1_ip ) = 1.0_wp if ( iwork >= jhigh ) return end if do ipj = ileft + iwork work ( iwork ) = t ( ipj ) - x imjp1 = ileft - iwork + 1_ip work ( k + iwork ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = iwork + 1_ip do l = 1_ip , iwork jp1ml = jp1 - l vm = vnikx ( l ) / ( work ( l ) + work ( k + jp1ml )) vnikx ( l ) = vm * work ( l ) + vmprev vmprev = vm * work ( k + jp1ml ) end do vnikx ( jp1 ) = vmprev iwork = jp1 if ( iwork >= jhigh ) exit end do end subroutine dbspvn","tags":"","loc":"proc/dbspvn.html"},{"title":"dbvalu – bspline-fortran","text":"private pure subroutine dbvalu(t, a, n, k, ideriv, x, inbv, work, iflag, val, extrap) Evaluates the b-representation ( t , a , n , k ) of a b-spline\n at x for the function value on ideriv=0 or any of its\n derivatives on ideriv=1,2,...,k-1 . right limiting values\n (right derivatives) are returned except at the right end\n point x=t(n+1) where left limiting values are computed. the\n spline is defined on t(k) x t(n+1) .\n dbvalu returns a fatal error message when x is outside of this\n interval. To compute left derivatives or left limiting values at a\n knot t(i) , replace n by i-1 and set x=t(i), i=k+1,n+1 . Error Conditions improper input History bvalue written by carl de boor [5] dbvalu author: amos, d. e., (snla) : date written 800901 revision date 820801 000330 modified array declarations. (jec) Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k real(kind=wp), intent(in), dimension(n) :: a b-spline coefficient vector of length n integer(kind=ip), intent(in) :: n number of b-spline coefficients.\n(sum of knot multiplicities- k ) integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: ideriv order of the derivative, 0 <= ideriv <= k-1 . ideriv = 0 returns the b-spline value real(kind=wp), intent(in) :: x argument, t(k) <= x <= t(n+1) integer(kind=ip), intent(inout) :: inbv an initialization parameter which must be set\nto 1 the first time dbvalu is called. inbv contains information for efficient processing\nafter the initial call and inbv must not\nbe changed by the user. distinct splines require\ndistinct inbv parameters. real(kind=wp), intent(inout), dimension(:) :: work work vector of length at least 3*k integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 401: k does not satisfy k 1 402: n does not satisfy n k 403: ideriv does not satisfy 0 ideriv k 404: x is not greater than or equal to t(k) 405: x is not less than or equal to t(n+1) 406: a left limiting value cannot be obtained at t(k) real(kind=wp), intent(out) :: val the interpolated value logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~dbvalu~~CallsGraph proc~dbvalu bspline_sub_module::dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbvalu~~CalledByGraph proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~dbvalu proc~db2val bspline_sub_module::db2val proc~db2val->proc~dbvalu proc~db3val bspline_sub_module::db3val proc~db3val->proc~dbvalu proc~db4val bspline_sub_module::db4val proc~db4val->proc~dbvalu proc~db5val bspline_sub_module::db5val proc~db5val->proc~dbvalu proc~db6val bspline_sub_module::db6val proc~db6val->proc~dbvalu proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbsgq8->proc~dbvalu proc~dbsqad bspline_sub_module::dbsqad proc~dbsqad->proc~dbvalu interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dbsgq8 proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbvalu ( t , a , n , k , ideriv , x , inbv , work , iflag , val , extrap ) implicit none real ( wp ), intent ( out ) :: val !! the interpolated value integer ( ip ), intent ( in ) :: n !! number of b-spline coefficients. !! (sum of knot multiplicities-`k`) real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k` real ( wp ), dimension ( n ), intent ( in ) :: a !! b-spline coefficient vector of length `n` integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: ideriv !! order of the derivative, `0 <= ideriv <= k-1`. !! `ideriv = 0` returns the b-spline value real ( wp ), intent ( in ) :: x !! argument, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( inout ) :: inbv !! an initialization parameter which must be set !! to 1 the first time [[dbvalu]] is called. !! `inbv` contains information for efficient processing !! after the initial call and `inbv` must not !! be changed by the user. distinct splines require !! distinct `inbv` parameters. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length at least `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 401: `k` does not satisfy `k` \\ge 1 !! * 402: `n` does not satisfy `n` \\ge `k` !! * 403: `ideriv` does not satisfy 0 \\le `ideriv` < `k` !! * 404: `x` is not greater than or equal to `t(k)` !! * 405: `x` is not less than or equal to `t(n+1)` !! * 406: a left limiting value cannot be obtained at `t(k)` logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: i , iderp1 , ihi , ihmkmj , ilo , imk , imkpj , ipj ,& ip1 , ip1mj , j , jj , j1 , j2 , kmider , kmj , km1 , kpk , mflag real ( wp ) :: fkmj real ( wp ) :: xt logical :: extrapolation_allowed !! if extrapolation is allowed val = 0.0_wp if ( k < 1_ip ) then iflag = 401_ip ! dbvalu - k does not satisfy k>=1 return end if if ( n < k ) then iflag = 402_ip ! dbvalu - n does not satisfy n>=k return end if if ( ideriv < 0_ip . or . ideriv >= k ) then iflag = 403_ip ! dbvalu - ideriv does not satisfy 0<=ideriv t ( n + 1_ip )) then xt = t ( n + 1_ip ) else xt = x end if else xt = x end if kmider = k - ideriv ! find *i* in (k,n) such that t(i) <= x < t(i+1) ! (or, <= t(i+1) if t(i) < t(i+1) = t(n+1)). km1 = k - 1_ip call dintrv ( t , n + 1 , xt , inbv , i , mflag ) if ( xt < t ( k )) then iflag = 404_ip ! dbvalu - x is not greater than or equal to t(k) return end if if ( mflag /= 0_ip ) then if ( xt > t ( i )) then iflag = 405_ip ! dbvalu - x is not less than or equal to t(n+1) return end if do if ( i == k ) then iflag = 406_ip ! dbvalu - a left limiting value cannot be obtained at t(k) return end if i = i - 1_ip if ( xt /= t ( i )) exit end do end if ! difference the coefficients *ideriv* times ! work(i) = aj(i), work(k+i) = dp(i), work(k+k+i) = dm(i), i=1.k imk = i - k do j = 1_ip , k imkpj = imk + j work ( j ) = a ( imkpj ) end do if ( ideriv /= 0_ip ) then do j = 1_ip , ideriv kmj = k - j fkmj = real ( kmj , wp ) do jj = 1_ip , kmj ihi = i + jj ihmkmj = ihi - kmj work ( jj ) = ( work ( jj + 1_ip ) - work ( jj )) / ( t ( ihi ) - t ( ihmkmj )) * fkmj end do end do end if ! compute value at *x* in (t(i),(t(i+1)) of ideriv-th derivative, ! given its relevant b-spline coeff. in aj(1),...,aj(k-ideriv). if ( ideriv /= km1 ) then ip1 = i + 1_ip kpk = k + k j1 = k + 1_ip j2 = kpk + 1_ip do j = 1_ip , kmider ipj = i + j work ( j1 ) = t ( ipj ) - x ip1mj = ip1 - j work ( j2 ) = x - t ( ip1mj ) j1 = j1 + 1_ip j2 = j2 + 1_ip end do iderp1 = ideriv + 1_ip do j = iderp1 , km1 kmj = k - j ilo = kmj do jj = 1_ip , kmj work ( jj ) = ( work ( jj + 1_ip ) * work ( kpk + ilo ) + work ( jj ) * & work ( k + jj )) / ( work ( kpk + ilo ) + work ( k + jj )) ilo = ilo - 1 end do end do end if iflag = 0_ip val = work ( 1_ip ) end subroutine dbvalu","tags":"","loc":"proc/dbvalu.html"},{"title":"dintrv – bspline-fortran","text":"private pure subroutine dintrv(xt, lxt, xx, ilo, ileft, mflag, extrap) Computes the largest integer ileft in 1 ileft lxt such that xt(ileft) x where xt(*) is a subdivision of\n the x interval.\n precisely, if x < xt ( 1 ) then ileft = 1 , mflag =- 1 if xt ( i ) <= x < xt ( i + 1 ) then ileft = i , mflag = 0 if xt ( lxt ) <= x then ileft = lxt , mflag =- 2 that is, when multiplicities are present in the break point\n to the left of x , the largest index is taken for ileft . History interv written by carl de boor [5] dintrv author: amos, d. e., (snla) : date written 800901 revision date 820801 Jacob Williams, 2/24/2015 : updated to free-form Fortran. Jacob Williams, 2/17/2016 : additional refactoring (eliminated GOTOs). Jacob Williams, 3/4/2017 : added extrapolation option. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: xt a knot or break point vector of length lxt integer(kind=ip), intent(in) :: lxt length of the xt vector real(kind=wp), intent(in) :: xx argument integer(kind=ip), intent(inout) :: ilo an initialization parameter which must be set\nto 1 the first time the spline array xt is\nprocessed by dintrv. ilo contains information for\nefficient processing after the initial call and ilo must not be changed by the user. distinct splines\nrequire distinct ilo parameters. integer(kind=ip), intent(out) :: ileft largest integer satisfying xt(ileft) x integer(kind=ip), intent(out) :: mflag signals when x lies out of bounds logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Calls proc~~dintrv~~CallsGraph proc~dintrv bspline_sub_module::dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dintrv~~CalledByGraph proc~dintrv bspline_sub_module::dintrv proc~db2val bspline_sub_module::db2val proc~db2val->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~db3val bspline_sub_module::db3val proc~db3val->proc~dintrv proc~db3val->proc~dbvalu proc~db4val bspline_sub_module::db4val proc~db4val->proc~dintrv proc~db4val->proc~dbvalu proc~db5val bspline_sub_module::db5val proc~db5val->proc~dintrv proc~db5val->proc~dbvalu proc~db6val bspline_sub_module::db6val proc~db6val->proc~dintrv proc~db6val->proc~dbvalu proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dintrv proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dbsqad bspline_sub_module::dbsqad proc~dbsqad->proc~dintrv proc~dbsqad->proc~dbvalu proc~dbvalu->proc~dintrv proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~db1val_alt bspline_sub_module::db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default bspline_sub_module::db1val_default proc~db1val_default->proc~dbvalu proc~dbsgq8->proc~dbvalu proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~evaluate_2d->proc~db2val proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~evaluate_3d->proc~db3val proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~evaluate_4d->proc~db4val proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~evaluate_5d->proc~db5val proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~evaluate_6d->proc~db6val interface~db1val bspline_sub_module::db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dintrv ( xt , lxt , xx , ilo , ileft , mflag , extrap ) implicit none integer ( ip ), intent ( in ) :: lxt !! length of the `xt` vector real ( wp ), dimension (:), intent ( in ) :: xt !! a knot or break point vector of length `lxt` real ( wp ), intent ( in ) :: xx !! argument integer ( ip ), intent ( inout ) :: ilo !! an initialization parameter which must be set !! to 1 the first time the spline array `xt` is !! processed by dintrv. `ilo` contains information for !! efficient processing after the initial call and `ilo` !! must not be changed by the user. distinct splines !! require distinct `ilo` parameters. integer ( ip ), intent ( out ) :: ileft !! largest integer satisfying `xt(ileft)` \\le `x` integer ( ip ), intent ( out ) :: mflag !! signals when `x` lies out of bounds logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: ihi , istep , middle real ( wp ) :: x x = get_temp_x_for_extrap ( xx , xt ( 1_ip ), xt ( lxt ), extrap ) ihi = ilo + 1_ip if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if if ( lxt <= 1 ) then mflag = - 1_ip ileft = 1_ip return end if ilo = lxt - 1_ip ihi = lxt end if if ( x >= xt ( ihi ) ) then ! now x >= xt(ilo). find upper bound istep = 1_ip do ilo = ihi ihi = ilo + istep if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if ihi = lxt else if ( x >= xt ( ihi ) ) then istep = istep * 2_ip cycle end if exit end do else if ( x >= xt ( ilo ) ) then mflag = 0_ip ileft = ilo return end if ! now x <= xt(ihi). find lower bound istep = 1_ip do ihi = ilo ilo = ihi - istep if ( ilo <= 1_ip ) then ilo = 1_ip if ( x < xt ( 1_ip ) ) then mflag = - 1_ip ileft = 1_ip return end if else if ( x < xt ( ilo ) ) then istep = istep * 2_ip cycle end if exit end do end if ! now xt(ilo) <= x < xt(ihi). narrow the interval do middle = ( ilo + ihi ) / 2_ip if ( middle == ilo ) then mflag = 0_ip ileft = ilo return end if ! note. it is assumed that middle = ilo in case ihi = ilo+1 if ( x < xt ( middle ) ) then ihi = middle else ilo = middle end if end do end subroutine dintrv","tags":"","loc":"proc/dintrv.html"},{"title":"dbint4 – bspline-fortran","text":"private pure subroutine dbint4(x, y, ndata, ibcl, ibcr, fbcl, fbcr, kntopt, tleft, tright, t, bcoef, n, k, w, iflag) DBINT4 computes the B representation ( t , bcoef , n , k ) of a\n cubic spline ( k=4 ) which interpolates data ( x(i) , y(i) ), i=1,ndata . Parameters ibcl , ibcr , fbcl , fbcr allow the specification of the spline\n first or second derivative at both x(1) and x(ndata) . When this data is not specified\n by the problem, it is common practice to use a natural spline by setting second\n derivatives at x(1) and x(ndata) to zero ( ibcl=ibcr=2 , fbcl=fbcr=0.0 ). The spline is defined on t(4) <= x <= t(n+1) with (ordered) interior knots at x(i) values where n=ndata+2. The knots t(1) , t(2) , t(3) lie to the left of t(4)=x(1) and the knots t(n+2) , t(n+3) , t(n+4) lie to the right of t(n+1)=x(ndata) in increasing order. If no extrapolation outside ( x(1) , x(ndata) ) is anticipated, the\n knots t(1)=t(2)=t(3)=t(4)=x(1) and t(n+2)=t(n+3)=t(n+4)=t(n+1)=x(ndata) can be specified by kntopt=1 . kntopt=2 selects a knot placement for t(1) , t(2) , t(3) to make the\n first 7 knots symmetric about t(4)=x(1) and similarly for t(n+2) , t(n+3) , t(n+4) about t(n+1)=x(ndata) . kntopt=3 allows the user to make his own selection, in increasing order,\n for t(1) , t(2) , t(3) to the left of x(1) and t(n+2) , t(n+3) , t(n+4) to\n the right of x(ndata). In any case, the interpolation on t(4) <= x <= t(n+1) by using function dbvalu is unique for given boundary\n conditions. Error conditions improper input singular system of equations See also dbintk History Written by D. E. Amos (SNLA), August, 1979. date written 800901 revision date 820801 000330 Modified array declarations. (JEC) Jacob Williams, 8/30/2018 : refactored to modern Fortran. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x x vector of abscissae of length ndata , distinct\nand in increasing order real(kind=wp), intent(in), dimension(:) :: y y vector of ordinates of length ndata integer(kind=ip), intent(in) :: ndata number of data points, ndata >= 2 integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: ibcl = 1 constrain the first derivative at x(1) to fbcl ibcl = 2 constrain the second derivative at x(1) to fbcl integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: ibcr = 1 constrain first derivative at x(ndata) to fbcr ibcr = 2 constrain second derivative at x(ndata) to fbcr real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: kntopt = 1 sets knot multiplicity at t(4) and t(n+1) to 4 kntopt = 2 sets a symmetric placement of knots\n about t(4) and t(n+1) kntopt = 3 sets t(i)=tleft(i) and t(n+1+i)=tright(i) , i=1,3 real(kind=wp), intent(in), dimension(3) :: tleft when kntopt = 3 : t(1:3) in increasing\norder to be supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright when kntopt = 3 : t(n+2:n+4) in increasing\norder to be supplied by the user. real(kind=wp), intent(out), dimension(:) :: t knot array of length n+4 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length n integer(kind=ip), intent(out) :: n number of coefficients, n=ndata+2 integer(kind=ip), intent(out) :: k order of spline, k=4 real(kind=wp), intent(inout), dimension(5,ndata+2) :: w work array integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 2001: ndata is less than 2 2002: x values are not distinct or not ordered 2003: ibcl is not 1 or 2 2004: ibcr is not 1 or 2 2005: kntopt is not 1, 2, or 3 2006: knot input through tleft , tright is\n not ordered properly 2007: the system of equations is singular Calls proc~~dbint4~~CallsGraph proc~dbint4 bspline_sub_module::dbint4 proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbint4~~CalledByGraph proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbint4 ( x , y , ndata , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , t , bcoef , n , k , w , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `ndata`, distinct !! and in increasing order real ( wp ), dimension (:), intent ( in ) :: y !! y vector of ordinates of length ndata integer ( ip ), intent ( in ) :: ndata !! number of data points, `ndata >= 2` integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(ndata)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(ndata)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(n+1)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(n+1)` !! * `kntopt = 3` sets `t(i)=tleft(i)` and !! `t(n+1+i)=tright(i)`,`i=1,3` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! when `kntopt = 3`: `t(1:3)` in increasing !! order to be supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! when `kntopt = 3`: `t(n+2:n+4)` in increasing !! order to be supplied by the user. real ( wp ), dimension (:), intent ( out ) :: t !! knot array of length `n+4` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `n` integer ( ip ), intent ( out ) :: n !! number of coefficients, `n=ndata+2` integer ( ip ), intent ( out ) :: k !! order of spline, `k=4` real ( wp ), dimension ( 5 , ndata + 2 ), intent ( inout ) :: w !! work array integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 2001: `ndata` is less than 2 !! * 2002: `x` values are not distinct or not ordered !! * 2003: `ibcl` is not 1 or 2 !! * 2004: `ibcr` is not 1 or 2 !! * 2005: `kntopt` is not 1, 2, or 3 !! * 2006: knot input through `tleft`, `tright` is !! not ordered properly !! * 2007: the system of equations is singular integer ( ip ) :: i , ilb , ileft , it , iub , iw , iwp , j , jw , ndm , np , nwrow real ( wp ) :: txn , tx1 , xl real ( wp ), dimension ( 4 , 4 ) :: vnikx real ( wp ), dimension ( 15 ) :: work !! work array for [[dbspvd]] -- length `(k+1)*(k+2)/2` real ( wp ), parameter :: wdtol = epsilon ( 1.0_wp ) !! d1mach(4) real ( wp ), parameter :: tol = sqrt ( wdtol ) if ( ndata < 2_ip ) then iflag = 2001_ip ! ndata is less than 2 return end if ndm = ndata - 1_ip do i = 1_ip , ndm if ( x ( i ) >= x ( i + 1_ip )) then iflag = 2002_ip ! x values are not distinct or not ordered return end if end do if ( ibcl < 1_ip . or . ibcl > 2_ip ) then iflag = 2003_ip ! ibcl is not 1 or 2 return end if if ( ibcr < 1_ip . or . ibcr > 2_ip ) then iflag = 2004_ip ! ibcr is not 1 or 2 return end if if ( kntopt < 1_ip . or . kntopt > 3_ip ) then iflag = 2005_ip ! kntopt is not 1, 2, or 3 return end if iflag = 0_ip k = 4_ip n = ndata + 2_ip np = n + 1_ip do i = 1_ip , ndata t ( i + 3 ) = x ( i ) end do select case ( kntopt ) case ( 1_ip ) ! set up knot array with multiplicity 4 at x(1) and x(ndata) do i = 1 , 3_ip t ( 4 - i ) = x ( 1 ) t ( np + i ) = x ( ndata ) end do case ( 2_ip ) !set up knot array with symmetric placement about end points if ( ndata > 3 ) then tx1 = x ( 1 ) + x ( 1 ) txn = x ( ndata ) + x ( ndata ) do i = 1 , 3 t ( 4 - i ) = tx1 - x ( i + 1 ) t ( np + i ) = txn - x ( ndata - i ) end do else xl = ( x ( ndata ) - x ( 1 )) / 3.0_wp do i = 1 , 3 t ( 4 - i ) = t ( 5 - i ) - xl t ( np + i ) = t ( np + i - 1 ) + xl end do end if case ( 3 ) ! set up knot array less than x(1) and greater than x(ndata) to be ! supplied by user in tleft & tright when kntopt=3 t ( 1 : 3 ) = tleft t ( ndata + 4 : ndata + 6 ) = tright do i = 1 , 3 if (( t ( 4 - i ) > t ( 5 - i )) . or . ( t ( np + i ) < t ( np + i - 1 ))) then iflag = 2006_ip ! knot input through tleft, tright is not ordered properly return end if end do end select w = 0.0_wp ! set up left interpolation point and left boundary condition for ! right limits it = ibcl + 1 call dbspvd ( t , k , it , x ( 1 ), k , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check iw = 0_ip if ( abs ( vnikx ( 3 , 1 )) < tol ) iw = 1_ip do j = 1 , 3 w ( j + 1 , 4 - j ) = vnikx ( 4 - j , it ) w ( j , 4 - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( 1 ) = y ( 1 ) bcoef ( 2 ) = fbcl ! set up interpolation equations for points i=2 to i=ndata-1 ileft = 4_ip if ( ndm >= 2 ) then do i = 2 , ndm ileft = ileft + 1_ip call dbspvd ( t , k , 1_ip , x ( i ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check do j = 1 , 3 w ( j + 1 , 3 + i - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( i + 1 ) = y ( i ) end do end if ! set up right interpolation point and right boundary condition for ! left limits(ileft is associated with t(n)=x(ndata-1)) it = ibcr + 1_ip call dbspvd ( t , k , it , x ( ndata ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check jw = 0_ip if ( abs ( vnikx ( 2 , 1 )) < tol ) jw = 1_ip do j = 1 , 3 w ( j + 1 , 3 + ndata - j ) = vnikx ( 5 - j , it ) w ( j + 2 , 3 + ndata - j ) = vnikx ( 5 - j , 1 ) end do bcoef ( n - 1 ) = fbcr bcoef ( n ) = y ( ndata ) ! solve system of equations ilb = 2_ip - jw iub = 2_ip - iw nwrow = 5_ip iwp = iw + 1_ip call dbnfac ( w ( iwp , 1 ), nwrow , n , ilb , iub , iflag ) if ( iflag == 2_ip ) then iflag = 2007_ip ! the system of equations is singular else iflag = 0_ip ! success call dbnslv ( w ( iwp , 1 ), nwrow , n , ilb , iub , bcoef ) end if end subroutine dbint4","tags":"","loc":"proc/dbint4.html"},{"title":"dbspvd – bspline-fortran","text":"private pure subroutine dbspvd(t, k, nderiv, x, ileft, ldvnik, vnikx, work, iflag) DBSPVD calculates the value and all derivatives of order\n less than nderiv of all basis functions which do not\n (possibly) vanish at x . ileft is input such that t(ileft) <= x < t(ileft+1) . A call to dintrv ( t , n+1 , x , ilo , ileft , mflag ) will produce the proper ileft . The output of\n dbspvd is a matrix vnikx(i,j) of dimension at least (k,nderiv) whose columns contain the k nonzero basis functions and\n their nderiv-1 right derivatives at x , i=1,k, j=1,nderiv .\n These basis functions have indices ileft-k+i , i=1,k,\n k <= ileft <= n . The nonzero part of the i -th basis\n function lies in (t(i),t(i+k)), i=1,n) . If x=t(ileft+1) then vnikx contains left limiting values\n (left derivatives) at t(ileft+1) . In particular, ileft = n produces left limiting values at the right end point x=t(n+1) . To obtain left limiting values at t(i) , i=k+1,n+1 ,\n set x = next lower distinct knot, call dintrv to get ileft ,\n set x=t(i) , and then call dbspvd. History Written by Carl de Boor and modified by D. E. Amos date written 800901 revision date 820801 000330 Modified array declarations. (JEC) Jacob Williams, 8/30/2018 : refactored to modern Fortran. Note DBSPVD is the BSPLVD routine of the reference. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities-k integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: nderiv number of derivatives = nderiv-1 , 1 <= nderiv <= k real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) integer(kind=ip), intent(in) :: ldvnik leading dimension of matrix vnikx real(kind=wp), intent(out), dimension(ldvnik,nderiv) :: vnikx matrix of dimension at least (k,nderiv) containing the nonzero basis functions\nat x and their derivatives columnwise. real(kind=wp), intent(out), dimension(*) :: work a work vector of length (k+1)*(k+2)/2 integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 3001: k does not satisfy k>=1 3002: nderiv does not satisfy 1<=nderiv<=k 3003: ldvnik does not satisfy ldvnik>=k Calls proc~~dbspvd~~CallsGraph proc~dbspvd bspline_sub_module::dbspvd proc~dbspvn bspline_sub_module::dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbspvd~~CalledByGraph proc~dbspvd bspline_sub_module::dbspvd proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbspvd proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbspvd ( t , k , nderiv , x , ileft , ldvnik , vnikx , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-k integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: nderiv !! number of derivatives = `nderiv-1`, !! `1 <= nderiv <= k` real ( wp ), intent ( in ) :: x !! argument of basis functions, !! `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that !! `t(ileft) <= x < t(ileft+1)` integer ( ip ), intent ( in ) :: ldvnik !! leading dimension of matrix `vnikx` real ( wp ), dimension ( ldvnik , nderiv ), intent ( out ) :: vnikx !! matrix of dimension at least `(k,nderiv)` !! containing the nonzero basis functions !! at `x` and their derivatives columnwise. real ( wp ), dimension ( * ), intent ( out ) :: work !! a work vector of length `(k+1)*(k+2)/2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 3001: `k` does not satisfy `k>=1` !! * 3002: `nderiv` does not satisfy `1<=nderiv<=k` !! * 3003: `ldvnik` does not satisfy `ldvnik>=k` integer ( ip ) :: i , ideriv , ipkmd , j , jj , jlow , jm , jp1mid , kmd , kp1 , l , ldummy , m , mhigh , iwork real ( wp ) :: factor , fkmd , v ! dimension t(ileft+k), work((k+1)*(k+2)/2) ! a(i,j) = work(i+j*(j+1)/2), i=1,j+1 j=1,k-1 ! a(i,k) = work(i+k*(k-1)/2) i=1.k ! work(1) and work((k+1)*(k+2)/2) are not used. if ( k < 1 ) then iflag = 3001_ip ! k does not satisfy k>=1 return end if if ( nderiv < 1 . or . nderiv > k ) then iflag = 3002_ip ! nderiv does not satisfy 1<=nderiv<=k return end if if ( ldvnik < k ) then iflag = 3003_ip ! ldvnik does not satisfy ldvnik>=k return end if iflag = 0_ip ideriv = nderiv kp1 = k + 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 1_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 . or . ideriv == 1 ) return mhigh = ideriv do m = 2 , mhigh jp1mid = 1 do j = ideriv , k vnikx ( j , ideriv ) = vnikx ( jp1mid , 1 ) jp1mid = jp1mid + 1 end do ideriv = ideriv - 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 2_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 ) return end do jm = kp1 * ( kp1 + 1 ) / 2 do l = 1 , jm work ( l ) = 0.0_wp end do ! a(i,i) = work(i*(i+3)/2) = 1.0 i = 1,k l = 2 j = 0 do i = 1 , k j = j + l work ( j ) = 1.0_wp l = l + 1 end do kmd = k do m = 2 , mhigh kmd = kmd - 1 fkmd = real ( kmd , wp ) i = ileft j = k jj = j * ( j + 1 ) / 2 jm = jj - j do ldummy = 1 , kmd ipkmd = i + kmd factor = fkmd / ( t ( ipkmd ) - t ( i )) do l = 1 , j work ( l + jj ) = ( work ( l + jj ) - work ( l + jm )) * factor end do i = i - 1 j = j - 1 jj = jm jm = jm - j end do do i = 1 , k v = 0.0_wp jlow = max ( i , m ) jj = jlow * ( jlow + 1 ) / 2 do j = jlow , k v = work ( i + jj ) * vnikx ( j , m ) + v jj = jj + j + 1 end do vnikx ( i , m ) = v end do end do end subroutine dbspvd","tags":"","loc":"proc/dbspvd.html"},{"title":"dbsqad – bspline-fortran","text":"private pure subroutine dbsqad(t, bcoef, n, k, x1, x2, bquad, work, iflag) DBSQAD computes the integral on (x1,x2) of a k -th order\n b-spline using the b-representation (t,bcoef,n,k) . orders k as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. If orders k greater than 20 are needed, use dbfqad with f(x) = 1 . Note The maximum number of significant digits obtainable in\n DBSQAD is the smaller of ~300 and the number of digits\n carried in real(wp) arithmetic. References D. E. Amos, \"Quadrature subroutines for splines and\n B-splines\", Report SAND79-1825, Sandia Laboratories,\n December 1979. History Author: Amos, D. E., (SNLA) 800901 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890531 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900326 Removed duplicate information from DESCRIPTION section. (WRB) 920501 Reformatted the REFERENCES section. (WRB) Jacob Williams, 9/6/2017 : refactored to modern Fortran.\n Added higher precision coefficients. Note Extrapolation is not enabled for this routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot array of length n+k real(kind=wp), intent(in), dimension(:) :: bcoef b-spline coefficient array of length n integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(out) :: bquad integral of the b-spline over ( x1 , x2 ) real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 901: k does not satisfy 1<=k<=20 902: n does not satisfy n>=k 903: x1 or x2 or both do\n not satisfy t(k)<=x<=t(n+1) Calls proc~~dbsqad~~CallsGraph proc~dbsqad bspline_sub_module::dbsqad proc~dbvalu bspline_sub_module::dbvalu proc~dbsqad->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbsqad->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbsqad~~CalledByGraph proc~dbsqad bspline_sub_module::dbsqad proc~db1sqad bspline_sub_module::db1sqad proc~db1sqad->proc~dbsqad proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~integral_1d->proc~db1sqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine dbsqad ( t , bcoef , n , k , x1 , x2 , bquad , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot array of length `n+k` real ( wp ), dimension (:), intent ( in ) :: bcoef !! b-spline coefficient array of length `n` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `1 <= k <= 20` real ( wp ), intent ( in ) :: x1 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( out ) :: bquad !! integral of the b-spline over (`x1`,`x2`) real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 901: `k` does not satisfy `1<=k<=20` !! * 902: `n` does not satisfy `n>=k` !! * 903: `x1` or `x2` or both do !! not satisfy `t(k)<=x<=t(n+1)` integer ( ip ) :: i , il1 , il2 , ilo , inbv , jf , left , m , mf , mflag , npk , np1 real ( wp ) :: a , aa , b , bb , bma , bpa , c1 , gx , q , ta , tb , y1 , y2 real ( wp ), dimension ( 5 ) :: s !! sum real ( wp ), dimension ( 9 ), parameter :: gpts = [ & & 0.577350269189625764509148780501957455647601751270126876018602326483977 & & 67230293334569371539558574952522520871380513556767665664836499965082627 & & 05518373647912161760310773007685273559916067003615583077550051041144223 & & 01107628883557418222973945990409015710553455953862673016662179126619796 & & 4892168_wp ,& & 0.238619186083196908630501721680711935418610630140021350181395164574274 & & 93427563984224922442725734913160907222309701068720295545303507720513526 & & 28872175189982985139866216812636229030578298770859440976999298617585739 & & 46921613621659222233462641640013936777894532787145324672151888999339900 & & 0945406150514997832_wp ,& & 0.661209386466264513661399595019905347006448564395170070814526705852183 & & 49660714310094428640374646145642988837163927514667955734677222538043817 & & 23198010093367423918538864300079016299442625145884902455718821970386303 & & 22362011735232135702218793618906974301231555871064213101639896769013566 & & 1651261150514997832_wp ,& & 0.932469514203152027812301554493994609134765737712289824872549616526613 & & 50084420019627628873992192598504786367972657283410658797137951163840419 & & 21786180750210169211578452038930846310372961174632524612619760497437974 & & 07422632089671621172178385230505104744277222209386367655366917903888025 & & 2326771150514997832_wp ,& & 0.148874338981631210884826001129719984617564859420691695707989253515903 & & 61735566852137117762979946369123003116080525533882610289018186437654023 & & 16761969968090913050737827720371059070942475859422743249837177174247346 & & 21691485290294292900319346665908243383809435507599683357023000500383728 & & 0634351_wp ,& & 0.433395394129247190799265943165784162200071837656246496502701513143766 & & 98907770350122510275795011772122368293504099893794727422475772324920512 & & 67741032822086200952319270933462032011328320387691584063411149801129823 & & 14148878744320432476641442157678880770848387945248811854979703928792696 & & 4254222_wp ,& & 0.679409568299024406234327365114873575769294711834809467664817188952558 & & 57539507492461507857357048037949983390204739931506083674084257663009076 & & 82741718202923543197852846977409718369143712013552962837733153108679126 & & 93254495485472934132472721168027426848661712101171203022718105101071880 & & 4444161_wp ,& & 0.865063366688984510732096688423493048527543014965330452521959731845374 & & 75513805556135679072894604577069440463108641176516867830016149345356373 & & 92729396890950011571349689893051612072435760480900979725923317923795535 & & 73929059587977695683242770223694276591148364371481692378170157259728913 & & 9322313_wp ,& & 0.973906528517171720077964012084452053428269946692382119231212066696595 & & 20323463615962572356495626855625823304251877421121502216860143447777992 & & 05409587259942436704413695764881258799146633143510758737119877875210567 & & 06745243536871368303386090938831164665358170712568697066873725922944928 & & 4383797_wp ] real ( wp ), dimension ( 9 ), parameter :: gwts = [ & & 1.0_wp ,& & 0.467913934572691047389870343989550994811655605769210535311625319963914 & & 20162039812703111009258479198230476626878975479710092836255417350295459 & & 35635592733866593364825926382559018030281273563502536241704619318259000 & & 99756987095900533474080074634376824431808173206369174103416261765346292 & & 7888917150514997832_wp ,& & 0.360761573048138607569833513837716111661521892746745482289739240237140 & & 03783726171832096220198881934794311720914037079858987989027836432107077 & & 67872114085818922114502722525757771126000732368828591631602895111800517 & & 40813685547074482472486101183259931449817216402425586777526768199930950 & & 3106873150514997832_wp ,& & 0.171324492379170345040296142172732893526822501484043982398635439798945 & & 76054234015464792770542638866975211652206987440430919174716746217597462 & & 96492293180314484520671351091683210843717994067668872126692485569940481 & & 59429327357024984053433824182363244118374610391205239119044219703570297 & & 7497812150514997832_wp ,& & 0.295524224714752870173892994651338329421046717026853601354308029755995 & & 93821715232927035659579375421672271716440125255838681849078955200582600 & & 19363424941869666095627186488841680432313050615358674090830512706638652 & & 87483901746874726597515954450775158914556548308329986393605934912382356 & & 670244_wp ,& & 0.269266719309996355091226921569469352859759938460883795800563276242153 & & 43231917927676422663670925276075559581145036869830869292346938114524155 & & 64658846634423711656014432259960141729044528030344411297902977067142537 & & 53480628460839927657500691168674984281408628886853320804215041950888191 & & 6391898_wp ,& & 0.219086362515982043995534934228163192458771870522677089880956543635199 & & 91065295128124268399317720219278659121687281288763476662690806694756883 & & 09211843316656677105269915322077536772652826671027878246851010208832173 & & 32006427348325475625066841588534942071161341022729156547776892831330068 & & 8702802_wp ,& & 0.149451349150580593145776339657697332402556639669427367835477268753238 & & 65472663001094594726463473195191400575256104543633823445170674549760147 & & 13716011937109528798134828865118770953566439639333773939909201690204649 & & 08381561877915752257830034342778536175692764212879241228297015017259084 & & 2897331_wp ,& & 0.066671344308688137593568809893331792857864834320158145128694881613412 & & 06408408710177678550968505887782109005471452041933148750712625440376213 & & 93049873169940416344953637064001870112423155043935262424506298327181987 & & 18647480566044117862086478449236378557180717569208295026105115288152794 & & 421677_wp ] iflag = 0_ip bquad = 0.0_wp if ( k < 1_ip . or . k > 20_ip ) then iflag = 901_ip ! error return else if ( n < k ) then iflag = 902_ip ! error return else aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ! selection of 2, 6, or 10 point gauss formula jf = 0_ip mf = 1_ip if ( k > 4_ip ) then jf = 1_ip mf = 3_ip if ( k > 12_ip ) then jf = 4_ip mf = 5_ip end if end if do i = 1_ip , mf s ( i ) = 0.0_wp end do ilo = 1_ip inbv = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) bma = 0.5_wp * ( b - a ) bpa = 0.5_wp * ( b + a ) do m = 1_ip , mf c1 = bma * gpts ( jf + m ) gx = - c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y2 ) if ( iflag /= 0_ip ) return gx = c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y1 ) if ( iflag /= 0_ip ) return s ( m ) = s ( m ) + ( y1 + y2 ) * bma end do end if end do q = 0.0_wp do m = 1_ip , mf q = q + gwts ( jf + m ) * s ( m ) end do if ( x1 > x2 ) q = - q bquad = q return end if end if iflag = 903_ip ! error return end if end subroutine dbsqad","tags":"","loc":"proc/dbsqad.html"},{"title":"dbfqad – bspline-fortran","text":"private subroutine dbfqad(f, t, bcoef, n, k, id, x1, x2, tol, quad, iflag, work) dbfqad computes the integral on (x1,x2) of a product of a\n function f and the id -th derivative of a k -th order b-spline,\n using the b-representation (t,bcoef,n,k) . (x1,x2) must be a\n subinterval of t(k) <= x <= t(n+1) . an integration routine, dbsgq8 (a modification of gaus8 ), integrates the product\n on subintervals of (x1,x2) formed by included (distinct) knots Reference D. E. Amos, \"Quadrature subroutines for splines and\n B-splines\", Report SAND79-1825, Sandia Laboratories,\n December 1979. History 800901 Amos, D. E., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890531 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900326 Removed duplicate information from DESCRIPTION section. (WRB) 920501 Reformatted the REFERENCES section. (WRB) Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes. Note the maximum number of significant digits obtainable in dbsqad is the smaller of ~300 and the number of digits\n carried in real(wp) arithmetic. Note Extrapolation is not enabled for this routine. Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: f external function of one argument for the\nintegrand bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work) real(kind=wp), intent(in), dimension(n+k) :: t knot array real(kind=wp), intent(in), dimension(n) :: bcoef coefficient array integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, k >= 1 integer(kind=ip), intent(in) :: id order of the spline derivative, 0 <= id <= k-1 id=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: quad integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: 0: no errors 1001: k does not satisfy k>=1 1002: n does not satisfy n>=k 1003: d does not satisfy 0<=idproc~dbsgq8 proc~dintrv bspline_sub_module::dintrv proc~dbfqad->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap proc~dbvalu->proc~dintrv Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbfqad~~CalledByGraph proc~dbfqad bspline_sub_module::dbfqad proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbfqad ( f , t , bcoef , n , k , id , x1 , x2 , tol , quad , iflag , work ) implicit none procedure ( b1fqad_func ) :: f !! external function of one argument for the !! integrand `bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work)` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `k >= 1` real ( wp ), dimension ( n + k ), intent ( in ) :: t !! knot array real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! coefficient array integer ( ip ), intent ( in ) :: id !! order of the spline derivative, `0 <= id <= k-1` !! `id=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: quad !! integral of `bf(x)` on `(x1,x2)` real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 1001: `k` does not satisfy `k>=1` !! * 1002: `n` does not satisfy `n>=k` !! * 1003: `d` does not satisfy `0<=id= k ) then iflag = 1003_ip ! error else if ( tol >= min_tol . and . tol <= 0.1_wp ) then aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ilo = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n inbv = 1_ip q = 0.0_wp do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) call dbsgq8 ( f , t , bcoef , n , k , id , a , b , inbv , err , ans , iflag , work ) if ( iflag /= 0_ip . and . iflag /= 1101_ip ) return q = q + ans end if end do if ( x1 > x2 ) q = - q quad = q end if else iflag = 1004_ip ! error end if else iflag = 1005_ip ! error end if end if end subroutine dbfqad","tags":"","loc":"proc/dbfqad.html"},{"title":"dbsgq8 – bspline-fortran","text":"private subroutine dbsgq8(fun, xt, bc, n, kk, id, a, b, inbv, err, ans, iflag, work) DBSGQ8, a modification of gaus8 ,\n integrates the product of fun(x) by the id -th derivative of a spline dbvalu between limits a and b using an adaptive 8-point Legendre-Gauss\n algorithm. See also dbfqad History 800901 Jones, R. E., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890911 Removed unnecessary intrinsics. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900326 Removed duplicate information from DESCRIPTION section. (WRB) 900328 Added TYPE section. (WRB) 910408 Updated the AUTHOR section. (WRB) Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes.\n Added higher precision coefficients. Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun name of external function of one\nargument which multiplies dbvalu . real(kind=wp), intent(in), dimension(:) :: xt knot array for dbvalu real(kind=wp), intent(in), dimension(n) :: bc b-coefficient array for dbvalu integer(kind=ip), intent(in) :: n number of b-coefficients for dbvalu integer(kind=ip), intent(in) :: kk order of the spline, kk>=1 integer(kind=ip), intent(in) :: id Order of the spline derivative, 0<=id<=kk-1 real(kind=wp), intent(in) :: a lower limit of integral real(kind=wp), intent(in) :: b upper limit of integral (may be less than a ) integer(kind=ip), intent(inout) :: inbv initialization parameter for dbvalu real(kind=wp), intent(inout) :: err IN: is a requested pseudorelative error\ntolerance. normally pick a value of abs(err)<1e-3 . ans will normally\nhave no more error than abs(err) times\nthe integral of the absolute value of fun(x)*[[dbvalu]]() . OUT: will be an estimate of the absolute\nerror in ans if the input value of err was negative. ( err is unchanged if\nthe input value of err was nonnegative.)\nthe estimated error is solely for information\nto the user and should not be used as a\ncorrection to the computed integral. real(kind=wp), intent(out) :: ans computed value of integral integer(kind=ip), intent(out) :: iflag a status code: 0: ans most likely meets requested\n error tolerance, or a=b . 1101: a and b are too nearly equal\n to allow normal integration. ans is set to zero. 1102: ans probably does not meet\n requested error tolerance. real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k for dbvalu Calls proc~~dbsgq8~~CallsGraph proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbsgq8~~CalledByGraph proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad bspline_sub_module::dbfqad proc~dbfqad->proc~dbsgq8 proc~db1fqad bspline_sub_module::db1fqad proc~db1fqad->proc~dbfqad proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbsgq8 ( fun , xt , bc , n , kk , id , a , b , inbv , err , ans , iflag , work ) implicit none procedure ( b1fqad_func ) :: fun !! name of external function of one !! argument which multiplies [[dbvalu]]. integer ( ip ), intent ( in ) :: n !! number of b-coefficients for [[dbvalu]] integer ( ip ), intent ( in ) :: kk !! order of the spline, `kk>=1` real ( wp ), dimension (:), intent ( in ) :: xt !! knot array for [[dbvalu]] real ( wp ), dimension ( n ), intent ( in ) :: bc !! b-coefficient array for [[dbvalu]] integer ( ip ), intent ( in ) :: id !! Order of the spline derivative, `0<=id<=kk-1` real ( wp ), intent ( in ) :: a !! lower limit of integral real ( wp ), intent ( in ) :: b !! upper limit of integral (may be less than `a`) integer ( ip ), intent ( inout ) :: inbv !! initialization parameter for [[dbvalu]] real ( wp ), intent ( inout ) :: err !! **IN:** is a requested pseudorelative error !! tolerance. normally pick a value of !! `abs(err)<1e-3`. `ans` will normally !! have no more error than `abs(err)` times !! the integral of the absolute value of !! `fun(x)*[[dbvalu]]()`. !! !! **OUT:** will be an estimate of the absolute !! error in ans if the input value of `err` !! was negative. (`err` is unchanged if !! the input value of `err` was nonnegative.) !! the estimated error is solely for information !! to the user and should not be used as a !! correction to the computed integral. real ( wp ), intent ( out ) :: ans !! computed value of integral integer ( ip ), intent ( out ) :: iflag !! a status code: !! !! * 0: `ans` most likely meets requested !! error tolerance, or `a=b`. !! * 1101: `a` and `b` are too nearly equal !! to allow normal integration. !! `ans` is set to zero. !! * 1102: `ans` probably does not meet !! requested error tolerance. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` for [[dbvalu]] integer ( ip ) :: k , l , lmn , lmx , mxl , nbits , nib , nlmx real ( wp ) :: ae , anib , area , c , ce , ee , ef , eps , est , gl , glr , tol , vr , x integer ( ip ), dimension ( 60 ) :: lr real ( wp ), dimension ( 60 ) :: aa , hh , vl , gr integer ( ip ), parameter :: i1mach14 = digits ( 1.0_wp ) !! i1mach(14) real ( wp ), parameter :: d1mach5 = log10 ( real ( radix ( x ), wp )) !! d1mach(5) real ( wp ), parameter :: ln2 = log ( 2.0_wp ) !! 0.69314718d0 real ( wp ), parameter :: sq2 = sqrt ( 2.0_wp ) integer ( ip ), parameter :: nlmn = 1 integer ( ip ), parameter :: kmx = 5000 integer ( ip ), parameter :: kml = 6 ! initialize inbv = 1_ip iflag = 0_ip k = i1mach14 anib = d1mach5 * k / 0.30102000_wp nbits = int ( anib , ip ) nlmx = min (( nbits * 5_ip ) / 8_ip , 60_ip ) ans = 0.0_wp ce = 0.0_wp if ( a == b ) then if ( err < 0.0_wp ) err = ce else lmx = nlmx lmn = nlmn if ( b /= 0.0_wp ) then if ( sign ( 1.0_wp , b ) * a > 0.0_wp ) then c = abs ( 1.0_wp - a / b ) if ( c <= 0.1_wp ) then if ( c <= 0.0_wp ) then if ( err < 0.0_wp ) err = ce return else anib = 0.5_wp - log ( c ) / ln2 nib = int ( anib , ip ) lmx = min ( nlmx , nbits - nib - 7_ip ) if ( lmx < 1_ip ) then ! a and b are too nearly equal ! to allow normal integration iflag = 1101_ip if ( err < 0.0_wp ) err = ce return else lmn = min ( lmn , lmx ) end if end if end if end if end if tol = max ( abs ( err ), 2.0_wp ** ( 5 - nbits )) / 2.0_wp if ( err == 0.0_wp ) tol = sqrt ( epsilon ( 1.0_wp )) eps = tol hh ( 1_ip ) = ( b - a ) / 4.0_wp aa ( 1_ip ) = a lr ( 1_ip ) = 1_ip l = 1_ip call g8 ( aa ( l ) + 2.0_wp * hh ( l ), 2.0_wp * hh ( l ), est , iflag ) if ( iflag /= 0_ip ) return k = 8_ip area = abs ( est ) ef = 0.5_wp mxl = 0_ip end if do ! compute refined estimates, estimate the error, etc. call g8 ( aa ( l ) + hh ( l ), hh ( l ), gl , iflag ) if ( iflag /= 0_ip ) return call g8 ( aa ( l ) + 3.0_wp * hh ( l ), hh ( l ), gr ( l ), iflag ) if ( iflag /= 0_ip ) return k = k + 16_ip area = area + ( abs ( gl ) + abs ( gr ( l )) - abs ( est )) glr = gl + gr ( l ) ee = abs ( est - glr ) * ef ae = max ( eps * area , tol * abs ( glr )) if ( ee > ae ) then ! consider the left half of this level if ( k > kmx ) lmx = kml if ( l >= lmx ) then mxl = 1_ip else l = l + 1_ip eps = eps * 0.5_wp ef = ef / sq2 hh ( l ) = hh ( l - 1 ) * 0.5_wp lr ( l ) = - 1_ip aa ( l ) = aa ( l - 1_ip ) est = gl cycle end if end if ce = ce + ( est - glr ) if ( lr ( l ) <= 0_ip ) then ! proceed to right half at this level vl ( l ) = glr else ! return one level vr = glr do if ( l <= 1_ip ) then ! exit ans = vr if ( ( mxl /= 0_ip ) . and . ( abs ( ce ) > 2.0_wp * tol * area ) ) then iflag = 1102_ip end if if ( err < 0.0_wp ) err = ce return else l = l - 1_ip eps = eps * 2.0_wp ef = ef * sq2 if ( lr ( l ) <= 0 ) then vl ( l ) = vl ( l + 1_ip ) + vr exit else vr = vl ( l + 1_ip ) + vr end if end if end do end if est = gr ( l - 1_ip ) lr ( l ) = 1_ip aa ( l ) = aa ( l ) + 4.0_wp * hh ( l ) end do contains subroutine g8 ( x , h , res , iflag ) !! 8-point formula. !! !!@note Replaced the original double precision abscissa and weight !! coefficients with the higher precision versions from here: !! http://pomax.github.io/bezierinfo/legendre-gauss.html !! So, if `wp` is changed to say, `real128`, more precision !! can be obtained. These coefficients have about 300 digits. implicit none real ( wp ), intent ( in ) :: x real ( wp ), intent ( in ) :: h real ( wp ), intent ( out ) :: res integer ( ip ), intent ( out ) :: iflag real ( wp ), dimension ( 8 ) :: f real ( wp ), dimension ( 8 ) :: v ! abscissa and weight coefficients: real ( wp ), parameter :: x1 = & & 0.1834346424956498049394761423601839806667578129129737823171884736992044 & & 742215421141160682237111233537452676587642867666089196012523876865683788 & & 569995160663568104475551617138501966385810764205532370882654749492812314 & & 961247764619363562770645716456613159405134052985058171969174306064445289 & & 638150514997832_wp real ( wp ), parameter :: x2 = & & 0.5255324099163289858177390491892463490419642431203928577508570992724548 & & 207685612725239614001936319820619096829248252608507108793766638779939805 & & 395303668253631119018273032402360060717470006127901479587576756241288895 & & 336619643528330825624263470540184224603688817537938539658502113876953598 & & 879150514997832_wp real ( wp ), parameter :: x3 = & & 0.7966664774136267395915539364758304368371717316159648320701702950392173 & & 056764730921471519272957259390191974534530973092653656494917010859602772 & & 562074621689676153935016290342325645582634205301545856060095727342603557 & & 415761265140428851957341933710803722783136113628137267630651413319993338 & & 002150514997832_wp real ( wp ), parameter :: x4 = & & 0.9602898564975362316835608685694729904282352343014520382716397773724248 & & 977434192844394389592633122683104243928172941762102389581552171285479373 & & 642204909699700433982618326637346808781263553346927867359663480870597542 & & 547603929318533866568132868842613474896289232087639988952409772489387324 & & 25615051499783203_wp real ( wp ), parameter :: w1 = & & 0.3626837833783619829651504492771956121941460398943305405248230675666867 & & 347239066773243660420848285095502587699262967065529258215569895173844995 & & 576007862076842778350382862546305771007553373269714714894268328780431822 & & 779077846722965535548199601402487767505928976560993309027632737537826127 & & 502150514997832_wp real ( wp ), parameter :: w2 = & & 0.3137066458778872873379622019866013132603289990027349376902639450749562 & & 719421734969616980762339285560494275746410778086162472468322655616056890 & & 624276469758994622503118776562559463287222021520431626467794721603822601 & & 295276898652509723185157998353156062419751736972560423953923732838789657 & & 919150514997832_wp real ( wp ), parameter :: w3 = & & 0.2223810344533744705443559944262408844301308700512495647259092892936168 & & 145704490408536531423771979278421592661012122181231114375798525722419381 & & 826674532090577908613289536840402789398648876004385697202157482063253247 & & 195590228631570651319965589733545440605952819880671616779621183704306688 & & 233150514997832_wp real ( wp ), parameter :: w4 = & & 0.1012285362903762591525313543099621901153940910516849570590036980647401 & & 787634707848602827393040450065581543893314132667077154940308923487678731 & & 973041136073584690533208824050731976306575729205467961435779467552492328 & & 730055025992954089946676810510810729468366466585774650346143712142008566 & & 866150514997832_wp res = 0.0_wp v ( 1_ip ) = x - x1 * h v ( 2_ip ) = x + x1 * h v ( 3_ip ) = x - x2 * h v ( 4_ip ) = x + x2 * h v ( 5_ip ) = x - x3 * h v ( 6_ip ) = x + x3 * h v ( 7_ip ) = x - x4 * h v ( 8_ip ) = x + x4 * h call dbvalu ( xt , bc , n , kk , id , v ( 1_ip ), inbv , work , iflag , f ( 1_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 2_ip ), inbv , work , iflag , f ( 2_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 3_ip ), inbv , work , iflag , f ( 3_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 4_ip ), inbv , work , iflag , f ( 4_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 5_ip ), inbv , work , iflag , f ( 5_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 6_ip ), inbv , work , iflag , f ( 6_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 7_ip ), inbv , work , iflag , f ( 7_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 8_ip ), inbv , work , iflag , f ( 8_ip )); if ( iflag /= 0_ip ) return res = h * (( w1 * ( fun ( v ( 1_ip )) * f ( 1_ip ) + fun ( v ( 2_ip )) * f ( 2_ip )) + & w2 * ( fun ( v ( 3_ip )) * f ( 3_ip ) + fun ( v ( 4_ip )) * f ( 4_ip ))) + & ( w3 * ( fun ( v ( 5_ip )) * f ( 5_ip ) + fun ( v ( 6_ip )) * f ( 6_ip )) + & w4 * ( fun ( v ( 7_ip )) * f ( 7_ip ) + fun ( v ( 8_ip )) * f ( 8_ip )))) end subroutine g8 end subroutine dbsgq8","tags":"","loc":"proc/dbsgq8.html"},{"title":"db1ink – bspline-fortran","text":"public interface db1ink 1D initialization routines. Calls interface~~db1ink~~CallsGraph interface~db1ink bspline_sub_module::db1ink proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by interface~~db1ink~~CalledByGraph interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure subroutine db1ink_default (x, nx, fcn, kx, iknot, tx, bcoef, iflag) Determines the parameters of a function that interpolates\n the one-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db1val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant: Read more… real(kind=wp), intent(out), dimension(:) :: bcoef (nx) array of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt_2 (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more…","tags":"","loc":"interface/db1ink.html"},{"title":"db1val – bspline-fortran","text":"public interface db1val 1D evaluation routines. Calls interface~~db1val~~CallsGraph interface~db1val bspline_sub_module::db1val proc~db1val_alt bspline_sub_module::db1val_alt interface~db1val->proc~db1val_alt proc~db1val_default bspline_sub_module::db1val_default interface~db1val->proc~db1val_default proc~check_value bspline_sub_module::check_value proc~db1val_alt->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt->proc~dbvalu proc~db1val_default->proc~check_value proc~db1val_default->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by interface~~db1val~~CalledByGraph interface~db1val bspline_sub_module::db1val proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure subroutine db1val_default (xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine db1val_alt (xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False)","tags":"","loc":"interface/db1val.html"},{"title":"ddot – bspline-fortran","text":"public function ddot(n, dx, incx, dy, incy) ddot forms the dot product of two vectors.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Return Value real(kind=wp) Called by proc~~ddot~~CalledByGraph proc~ddot bspline_blas_module::ddot proc~dcv bspline_defc_module::dcv proc~dcv->proc~ddot proc~dh12 bspline_defc_module::dh12 proc~dh12->proc~ddot proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~ddot proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~ddot proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dlpdp proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dbndac bspline_defc_module::dbndac proc~dbndac->proc~dh12 proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfcmn->proc~dbndac proc~dhfti->proc~dh12 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dh12 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dwnlit proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dwnnls->proc~dwnlsm proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code real ( wp ) function ddot ( n , dx , incx , dy , incy ) !! ddot forms the dot product of two vectors. !! uses unrolled loops for increments equal to one. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 ddot = 0.0_wp dtemp = 0.0_wp if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dtemp + dx ( i ) * dy ( i ) end do if ( n < 5_ip ) then ddot = dtemp return end if end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dtemp = dtemp + dx ( i ) * dy ( i ) + & dx ( i + 1_ip ) * dy ( i + 1_ip ) + dx ( i + 2_ip ) * dy ( i + 2_ip ) + & dx ( i + 3_ip ) * dy ( i + 3_ip ) + dx ( i + 4_ip ) * dy ( i + 4_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dtemp + dx ( ix ) * dy ( iy ) ix = ix + incx iy = iy + incy end do end if ddot = dtemp end function ddot","tags":"","loc":"proc/ddot.html"},{"title":"dnrm2 – bspline-fortran","text":"public function dnrm2(n, x, incx) returns the euclidean norm of a vector Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: x (*) integer(kind=ip) :: incx Return Value real(kind=wp) Called by proc~~dnrm2~~CalledByGraph proc~dnrm2 bspline_blas_module::dnrm2 proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dnrm2 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dnrm2 proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dlsi->proc~dlpdp proc~dwnnls->proc~dwnlsm proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module.","tags":"","loc":"proc/dnrm2.html"},{"title":"dasum – bspline-fortran","text":"public function dasum(n, dx, incx) dasum takes the sum of the absolute values. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value real(kind=wp) Called by proc~~dasum~~CalledByGraph proc~dasum bspline_blas_module::dasum proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dasum proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dasum proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dasum proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dlpdp->proc~dwnnls Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code real ( wp ) function dasum ( n , dx , incx ) !! dasum takes the sum of the absolute values. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) dtemp integer ( ip ) i , m , mp1 , nincx dasum = 0.0_wp dtemp = 0.0_wp if ( n <= 0 . or . incx <= 0 ) return if ( incx == 1 ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 6 ) if ( m /= 0 ) then do i = 1 , m dtemp = dtemp + abs ( dx ( i )) end do if ( n < 6 ) then dasum = dtemp return end if end if mp1 = m + 1 do i = mp1 , n , 6 dtemp = dtemp + abs ( dx ( i )) + abs ( dx ( i + 1 )) + & abs ( dx ( i + 2 )) + abs ( dx ( i + 3 )) + & abs ( dx ( i + 4 )) + abs ( dx ( i + 5 )) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1 , nincx , incx dtemp = dtemp + abs ( dx ( i )) end do end if dasum = dtemp end function dasum","tags":"","loc":"proc/dasum.html"},{"title":"idamax – bspline-fortran","text":"public function idamax(n, dx, incx) idamax finds the index of the first element having maximum absolute value. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value integer Called by proc~~idamax~~CalledByGraph proc~idamax bspline_blas_module::idamax proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~idamax proc~dwnlsm->proc~dwnlit proc~dwnlt1->proc~idamax proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code integer function idamax ( n , dx , incx ) !! idamax finds the index of the first element having maximum absolute value. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) :: dmax integer ( ip ) :: i , ix idamax = 0 if ( n < 1 . or . incx <= 0 ) return idamax = 1 if ( n == 1 ) return if ( incx == 1 ) then ! code for increment equal to 1 dmax = abs ( dx ( 1 )) do i = 2 , n if ( abs ( dx ( i )) > dmax ) then idamax = i dmax = abs ( dx ( i )) end if end do else ! code for increment not equal to 1 ix = 1 dmax = abs ( dx ( 1 )) ix = ix + incx do i = 2 , n if ( abs ( dx ( ix )) > dmax ) then idamax = i dmax = abs ( dx ( ix )) end if ix = ix + incx end do end if end function idamax","tags":"","loc":"proc/idamax.html"},{"title":"daxpy – bspline-fortran","text":"public subroutine daxpy(n, da, dx, incx, dy, incy) DAXPY constant times a vector plus a vector.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Called by proc~~daxpy~~CalledByGraph proc~daxpy bspline_blas_module::daxpy proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~daxpy proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dbndac bspline_defc_module::dbndac proc~dfcmn->proc~dbndac proc~dh12 bspline_defc_module::dh12 proc~dh12->proc~daxpy proc~dlsei->proc~daxpy proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~daxpy proc~dlsi->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dh12 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~dbndac->proc~dh12 proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dhfti->proc~dh12 proc~dwnlit->proc~dh12 proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dlpdp->proc~dwnnls proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine daxpy ( n , da , dx , incx , dy , incy ) !! DAXPY constant times a vector plus a vector. !! uses unrolled loops for increments equal to one. real ( wp ) :: da integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( da == 0.0_wp ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 4_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dy ( i ) + da * dx ( i ) end do end if if ( n < 4_ip ) return mp1 = m + 1_ip do i = mp1 , n , 4_ip dy ( i ) = dy ( i ) + da * dx ( i ) dy ( i + 1_ip ) = dy ( i + 1_ip ) + da * dx ( i + 1_ip ) dy ( i + 2_ip ) = dy ( i + 2_ip ) + da * dx ( i + 2_ip ) dy ( i + 3_ip ) = dy ( i + 3_ip ) + da * dx ( i + 3_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dy ( iy ) + da * dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine daxpy","tags":"","loc":"proc/daxpy.html"},{"title":"dcopy – bspline-fortran","text":"public subroutine dcopy(n, dx, incx, dy, incy) DCOPY copies a vector, x, to a vector, y.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Called by proc~~dcopy~~CalledByGraph proc~dcopy bspline_blas_module::dcopy proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dcopy proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dcopy proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dcopy proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei->proc~dcopy proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dcopy proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dcopy proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dwnlit proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dwnnls->proc~dwnlsm Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dcopy ( n , dx , incx , dy , incy ) !! DCOPY copies a vector, x, to a vector, y. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 7_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dx ( i ) end do if ( n < 7_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 7_ip dy ( i ) = dx ( i ) dy ( i + 1_ip ) = dx ( i + 1_ip ) dy ( i + 2_ip ) = dx ( i + 2_ip ) dy ( i + 3_ip ) = dx ( i + 3_ip ) dy ( i + 4_ip ) = dx ( i + 4_ip ) dy ( i + 5_ip ) = dx ( i + 5_ip ) dy ( i + 6_ip ) = dx ( i + 6_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine dcopy","tags":"","loc":"proc/dcopy.html"},{"title":"dscal – bspline-fortran","text":"public subroutine dscal(n, da, dx, incx) DSCAL scales a vector by a constant.\nuses unrolled loops for increment equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx Called by proc~~dscal~~CalledByGraph proc~dscal bspline_blas_module::dscal proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dscal proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dscal proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dscal proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dlsei->proc~dscal proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dscal proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dscal proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dwnlit proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dwnnls->proc~dwnlsm Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dscal ( n , da , dx , incx ) !! DSCAL scales a vector by a constant. !! uses unrolled loops for increment equal to 1. real ( wp ) :: da integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) integer i , m , mp1 , nincx if ( n <= 0_ip . or . incx <= 0_ip ) return if ( incx == 1_ip ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dx ( i ) = da * dx ( i ) end do if ( n < 5_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dx ( i ) = da * dx ( i ) dx ( i + 1_ip ) = da * dx ( i + 1_ip ) dx ( i + 2_ip ) = da * dx ( i + 2_ip ) dx ( i + 3_ip ) = da * dx ( i + 3_ip ) dx ( i + 4_ip ) = da * dx ( i + 4_ip ) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1_ip , nincx , incx dx ( i ) = da * dx ( i ) end do end if end subroutine dscal","tags":"","loc":"proc/dscal.html"},{"title":"dswap – bspline-fortran","text":"public subroutine dswap(n, dx, incx, dy, incy) DSWAP interchanges two vectors.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Called by proc~~dswap~~CalledByGraph proc~dswap bspline_blas_module::dswap proc~dh12 bspline_defc_module::dh12 proc~dh12->proc~dswap proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dswap proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dswap proc~dlsi->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dswap proc~dwnlit->proc~dh12 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dswap proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dwnlit proc~dwnlt3->proc~dswap proc~dbndac bspline_defc_module::dbndac proc~dbndac->proc~dh12 proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfcmn->proc~dbndac proc~dhfti->proc~dh12 proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dlpdp->proc~dwnnls proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dswap ( n , dx , incx , dy , incy ) !! DSWAP interchanges two vectors. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 3_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp end do if ( n < 3_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 3_ip dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp dtemp = dx ( i + 1_ip ) dx ( i + 1_ip ) = dy ( i + 1_ip ) dy ( i + 1_ip ) = dtemp dtemp = dx ( i + 2_ip ) dx ( i + 2_ip ) = dy ( i + 2_ip ) dy ( i + 2_ip ) = dtemp end do else ! code for unequal increments or equal increments not equal ! to 1 ix = 1 iy = 1 if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dx ( ix ) dx ( ix ) = dy ( iy ) dy ( iy ) = dtemp ix = ix + incx iy = iy + incy end do end if end subroutine dswap","tags":"","loc":"proc/dswap.html"},{"title":"drotm – bspline-fortran","text":"public subroutine drotm(n, dx, incx, dy, incy, dparam) apply the modified givens transformation, H, to the 2 by n matrix Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy real(kind=wp) :: dparam (5) Called by proc~~drotm~~CalledByGraph proc~drotm bspline_blas_module::drotm proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~drotm proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~drotm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine drotm ( n , dx , incx , dy , incy , dparam ) !! apply the modified givens transformation, H, to the 2 by n matrix integer ( ip ) :: incx , incy , n real ( wp ) :: dparam ( 5 ), dx ( * ), dy ( * ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , w , z integer ( ip ) :: i , kx , ky , nsteps real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: two = 2.0_wp dflag = dparam ( 1 ) if ( n <= 0 . or . ( dflag + two == zero )) return if ( incx == incy . and . incx > 0 ) then nsteps = n * incx if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z * dh12 dy ( i ) = w * dh21 + z * dh22 end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w + z * dh12 dy ( i ) = w * dh21 + z end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z dy ( i ) = - w + dh22 * z end do end if else kx = 1 ky = 1 if ( incx < 0 ) kx = 1 + ( 1 - n ) * incx if ( incy < 0 ) ky = 1 + ( 1 - n ) * incy if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z * dh12 dy ( ky ) = w * dh21 + z * dh22 kx = kx + incx ky = ky + incy end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w + z * dh12 dy ( ky ) = w * dh21 + z kx = kx + incx ky = ky + incy end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z dy ( ky ) = - w + dh22 * z kx = kx + incx ky = ky + incy end do end if end if end subroutine drotm","tags":"","loc":"proc/drotm.html"},{"title":"drotmg – bspline-fortran","text":"public subroutine drotmg(dd1, dd2, dx1, dy1, dparam) construct the modified givens transformation matrix H Arguments Type Intent Optional Attributes Name real(kind=wp) :: dd1 real(kind=wp) :: dd2 real(kind=wp) :: dx1 real(kind=wp) :: dy1 real(kind=wp) :: dparam (5) Called by proc~~drotmg~~CalledByGraph proc~drotmg bspline_blas_module::drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~drotmg proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~drotmg proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine drotmg ( dd1 , dd2 , dx1 , dy1 , dparam ) !! construct the modified givens transformation matrix H real ( wp ) :: dd1 , dd2 , dx1 , dy1 real ( wp ) :: dparam ( 5 ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , dp1 , dp2 , dq1 , dq2 , dtemp ,& du real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: two = 2.0_wp real ( wp ), parameter :: gam = 409 6.0_wp real ( wp ), parameter :: gamsq = gam * gam !! 16777216.0_wp real ( wp ), parameter :: rgamsq = one / gamsq !! 5.9604645e-8_wp if ( dd1 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else ! case-dd1-nonnegative dp2 = dd2 * dy1 if ( dp2 == zero ) then dflag = - two dparam ( 1 ) = dflag return end if ! regular-case.. dp1 = dd1 * dx1 dq2 = dp2 * dy1 dq1 = dp1 * dx1 if ( abs ( dq1 ) > abs ( dq2 )) then dh21 = - dy1 / dx1 dh12 = dp2 / dp1 du = one - dh12 * dh21 if ( du > zero ) then dflag = zero dd1 = dd1 / du dd2 = dd2 / du dx1 = dx1 * du else ! this code path if here for safety. we do not expect this ! condition to ever hold except in edge cases with rounding ! errors. see doi: 10.1145/355841.355847 dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero end if else if ( dq2 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else dflag = one dh11 = dp1 / dp2 dh22 = dx1 / dy1 du = one + dh11 * dh22 dtemp = dd2 / du dd2 = dd1 / du dd1 = dtemp dx1 = dy1 * du end if end if ! procedure..scale-check if ( dd1 /= zero ) then do while (( dd1 <= rgamsq ) . or . ( dd1 >= gamsq )) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( dd1 <= rgamsq ) then dd1 = dd1 * gam ** 2 dx1 = dx1 / gam dh11 = dh11 / gam dh12 = dh12 / gam else dd1 = dd1 / gam ** 2 dx1 = dx1 * gam dh11 = dh11 * gam dh12 = dh12 * gam end if enddo end if if ( dd2 /= zero ) then do while ( ( abs ( dd2 ) <= rgamsq ) . or . ( abs ( dd2 ) >= gamsq ) ) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( abs ( dd2 ) <= rgamsq ) then dd2 = dd2 * gam ** 2 dh21 = dh21 / gam dh22 = dh22 / gam else dd2 = dd2 / gam ** 2 dh21 = dh21 * gam dh22 = dh22 * gam end if end do end if end if if ( dflag < zero ) then dparam ( 2 ) = dh11 dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 dparam ( 5 ) = dh22 else if ( dflag == zero ) then dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 else dparam ( 2 ) = dh11 dparam ( 5 ) = dh22 end if dparam ( 1 ) = dflag end subroutine drotmg","tags":"","loc":"proc/drotmg.html"},{"title":"dwnlt2 – bspline-fortran","text":"private function dwnlt2(me, mend, ir, factor, tau, scale, wic) To test independence of incoming column. Test the column IC to determine if it is linearly independent\n of the columns already in the basis. In the initial tri. step,\n we usually want the heavy weight ALAMDA to be included in the\n test for independence. In this case, the value of FACTOR will\n have been set to 1.0 before this procedure is invoked.\n In the potentially rank deficient problem, the value of FACTOR\n will have been set to ALSQ=ALAMDA**2 to remove the effect of the\n heavy weight from the test for independence. Write new column as partitioned vector (A1) number of components in solution so far = NIV (A2) M-NIV components And compute SN = inverse weighted length of A1 RN = inverse weighted length of A2 Call the column independent when RN > TAU*SN Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890620 Code extracted from WNLIT and made a subroutine. (RWC)) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer :: me integer :: mend integer :: ir real(kind=wp) :: factor real(kind=wp) :: tau real(kind=wp) :: scale (*) real(kind=wp) :: wic (*) Return Value logical Called by proc~~dwnlt2~~CalledByGraph proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dwnlt2 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code logical function dwnlt2 ( me , mend , ir , factor , tau , scale , wic ) real ( wp ) :: factor , scale ( * ), tau , wic ( * ) integer :: ir , me , mend real ( wp ) :: rn , sn , t integer :: j sn = 0.0_wp rn = 0.0_wp do j = 1 , mend t = scale ( j ) if ( j <= me ) t = t / factor t = t * wic ( j ) ** 2 if ( j < ir ) then sn = sn + t else rn = rn + t endif end do dwnlt2 = rn > sn * tau ** 2 end function dwnlt2","tags":"","loc":"proc/dwnlt2.html"},{"title":"dcv – bspline-fortran","text":"public function dcv(xval, ndata, nconst, nord, nbkpt, bkpt, w) dcv is a companion function subprogram for dfc . The\n documentation for dfc has complete usage instructions. dcv is used to evaluate the variance function of the curve\n obtained by the constrained B-spline fitting subprogram, dfc .\n The variance function defines the square of the probable error\n of the fitted curve at any point, XVAL. One can use the square\n root of this variance function to determine a probable error band\n around the fitted curve. dcv is used after a call to dfc . MODE, an input variable to dfc , is used to indicate if the variance function is desired.\n In order to use dcv , MODE must equal 2 or 4 on input to dfc .\n MODE is also used as an output flag from dfc . Check to make\n sure that MODE = 0 after calling dfc , indicating a successful\n constrained curve fit. The array SDDATA, as input to dfc , must\n also be defined with the standard deviation or uncertainty of the\n Y values to use dcv . To evaluate the variance function after calling dfc as stated\n above, use dcv as shown here VAR = DCV(XVAL,NDATA,NCONST,NORD,NBKPT,BKPT,W) The variance function is given by VAR = (transpose of B(XVAL))*C*B(XVAL)/DBLE(MAX(NDATA-N,1)) where N = NBKPT - NORD . The vector B(XVAL) is the B-spline basis function values at\n X=XVAL. The covariance matrix, C, of the solution coefficients\n accounts only for the least squares equations and the explicitly\n stated equality constraints. This fact must be considered when\n interpreting the variance function from a data fitting problem\n that has inequality constraints on the fitted curve. All the variables in the calling sequence for dcv are used in dfc except the variable XVAL. Do not change the values of\n these variables between the call to dfc and the use of dcv . Reference R. J. Hanson, Constrained least squares curve fitting\n to discrete data using B-splines, a users guide,\n Report SAND78-1291, Sandia Laboratories, December\n 1978. Revision history 780801 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890831 Modified array declarations. (WRB) 890911 Removed unnecessary intrinsics. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval The point where the variance is desired integer, intent(in) :: ndata The number of discrete (X,Y) pairs for which dfc calculated a piece-wise polynomial curve. integer, intent(in) :: nconst The number of conditions that constrained the B-spline in dfc . integer, intent(in) :: nord The order of the B-spline used in dfc .\nThe value of NORD must satisfy 1 < NORD < 20 . (The order of the spline is one more than the degree of\nthe piece-wise polynomial defined on each interval. This\nis consistent with the B-spline package convention. For\nexample, NORD=4 when we are using piece-wise cubics.) integer, intent(in) :: nbkpt The number of knots in the array BKPT( ).\nThe value of NBKPT must satisfy NBKPT .GE. 2 NORD. real(kind=wp), intent(in) :: bkpt (*) The array of knots. Normally the problem\ndata interval will be included between the limits\nBKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end\nknots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT,\nare required by dfc to compute the functions used to\nfit the data. real(kind=wp) :: w (*) Real work array as used in dfc . See dfc for the required length of W( ). The contents of W( )\nmust not be modified by the user if the variance function\nis desired. Return Value real(kind=wp) Calls proc~~dcv~~CallsGraph proc~dcv bspline_defc_module::dcv proc~ddot bspline_blas_module::ddot proc~dcv->proc~ddot proc~dfspvn bspline_defc_module::dfspvn proc~dcv->proc~dfspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code real ( wp ) function dcv ( xval , ndata , nconst , nord , nbkpt , bkpt , w ) real ( wp ), intent ( in ) :: xval !! The point where the variance is desired integer , intent ( in ) :: nbkpt !! The number of knots in the array BKPT(*). !! The value of NBKPT must satisfy NBKPT .GE. 2*NORD. integer , intent ( in ) :: nconst !! The number of conditions that constrained the B-spline in !! [[dfc]]. integer , intent ( in ) :: ndata !! The number of discrete (X,Y) pairs for which [[dfc]] !! calculated a piece-wise polynomial curve. integer , intent ( in ) :: nord !! The order of the B-spline used in [[dfc]]. !! The value of NORD must satisfy 1 < NORD < 20 . !! !! (The order of the spline is one more than the degree of !! the piece-wise polynomial defined on each interval. This !! is consistent with the B-spline package convention. For !! example, NORD=4 when we are using piece-wise cubics.) real ( wp ), intent ( in ) :: bkpt ( * ) !! The array of knots. Normally the problem !! data interval will be included between the limits !! BKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end !! knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT, !! are required by [[dfc]] to compute the functions used to !! fit the data. real ( wp ) :: w ( * ) !! Real work array as used in [[dfc]]. See [[dfc]] !! for the required length of W(*). The contents of W(*) !! must not be modified by the user if the variance function !! is desired. real ( wp ) :: v ( 40 ) integer :: i , ileft , ip , is , last , mdg , mdw , n integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap real ( wp ), parameter :: zero = 0.0_wp ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = zero dfspvn_deltap = zero mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst is = mdg * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + nord ** 2 last = nbkpt - nord + 1 ileft = nord do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= last - 1 ) exit ileft = ileft + 1 end do call dfspvn ( bkpt , nord , 1 , xval , ileft , v ( nord + 1 ), & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ileft = ileft - nord + 1 ip = mdw * ( ileft - 1 ) + ileft + is n = nbkpt - nord do i = 1 , nord v ( i ) = ddot ( nord , w ( ip ), 1 , v ( nord + 1 ), 1 ) ip = ip + mdw end do dcv = max ( ddot ( nord , v , 1 , v ( nord + 1 ), 1 ), zero ) ! scale the variance so it is an unbiased estimate. dcv = dcv / max ( ndata - n , 1 ) end function dcv","tags":"","loc":"proc/dcv.html"},{"title":"defc – bspline-fortran","text":"public subroutine defc(Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkpt, Mdein, Mdeout, Coeff, Lw, w) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense. The data can be processed in groups of modest size.\n The size of the group is chosen by the user. This feature\n may be necessary for purposes of using constrained curve fitting\n with subprogram DFC on a very large data set. Evaluating the Fitted Curve To evaluate derivative number IDER at XVAL ,\n use the function subprogram DBVALU . f = dbvalu ( bkpt , coeff , nbkpt - nord , nord , ider , xval , inbv , workb ) The output of this subprogram will not be\n defined unless an output value of MDEOUT=1 was obtained from DEFC , XVAL is in the data\n interval, and IDER is nonnegative and < NORD . The first time DBVALU is called, INBV=1 must be specified. This value of INBV is the\n overwritten by DBVALU . The array WORKB(*) must be of length at least 3*NORD , and must\n not be the same as the W(*) array used in the\n call to DEFC . DBVALU expects the breakpoint array BKPT(*) to be sorted. Revision history 800801 DATE WRITTEN.\n WRITTEN BY R. HANSON, SANDIA NATL. LABS.,\n ALB., N. M., AUGUST-SEPTEMBER, 1980. 890531 Changed all specific intrinsics to generic. (WRB) 890531 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900510 Change Prologue comments to refer to XERMSG. (RWC) 900607 Editorial changes to Prologue to make Prologues for EFC,\n DEFC, FC, and DFC look as much the same as possible. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Jacob Williams, 2022 : modernized Arguments Type Intent Optional Attributes Name integer, intent(in) :: Ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in), dimension(ndata) :: Xdata X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in), dimension(ndata) :: Ydata Y data array. real(kind=wp), intent(in), dimension(ndata) :: Sddata Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: Nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(:) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: Mdein An integer flag, with one of two possible\nvalues (1 or 2), that directs the subprogram\naction with regard to new data points provided\nby the user: = 1 The first time that DEFC has been\n entered. There are NDATA points to process. = 2 This is another entry to DEFC(). The\n subprogram DEFC has been entered with MDEIN=1\n exactly once before for this problem. There\n are NDATA new additional points to merge and\n process with any previous points.\n (When using DEFC with MDEIN=2 it is\n important that the set of knots remain fixed at the\n same values for all entries to DEFC .) integer, intent(out) :: Mdeout An output flag that indicates the status\nof the curve fit: =-1 A usage error of DEFC occurred. The\n offending condition is noted with the SLATEC\n library error processor, XERMSG( ) . In case\n the working array W(*) is not long enough, the\n minimal acceptable length is printed. =1 The B-spline coefficients for the fitted\n curve have been returned in array COEFF(*) . =2 Not enough data has been processed to\n determine the B-spline coefficients.\n The user has one of two options. Continue\n to process more data until a unique set\n of coefficients is obtained, or use the\n subprogram DFC to obtain a specific\n set of coefficients. The user should read\n the usage instructions for DFC for further\n details if this second option is chosen. real(kind=wp), intent(out) :: Coeff (*) If the output value of MDEOUT=1 , this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD parameters are the B-spline coefficients.\nFor MDEOUT=2 , not enough data was processed to\nuniquely determine the B-spline coefficients.\nIn this case, and also when MDEOUT=-1 , all\nvalues of COEFF(*) are set to zero. If the user is not satisfied with the fitted\ncurve returned by DEFC , the constrained\nleast squares curve fitting subprogram DFC may be required. The work done within DEFC to accumulate the data can be utilized by\nthe user, if so desired. This involves\nsaving the first (NBKPT-NORD+3)*(NORD+1) entries of W(*) and providing this data\nto DFC with the \"old problem\" designation.\nThe user should read the usage instructions\nfor subprogram DFC for further details. integer, intent(in) :: Lw The amount of working storage actually\n allocated for the working array W(*) .\n This quantity is compared with the\n actual amount of storage needed in DEFC .\n Insufficient storage allocated for W(*) is\n an error. This feature was included in DEFC because misreading the storage formula\n for W(*) might very well lead to subtle\n and hard-to-find programming bugs. The length of the array W(*) must satisfy LW >= (NBKPT-NORD+3)*(NORD+1)+\n (NBKPT+1)*(NORD+1)+\n 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 real(kind=wp) :: w (*) Working Array.\nIts length is specified as an input parameter\nin LW as noted above. The contents of W(*) must not be modified by the user between calls\nto DEFC with values of MDEIN=1,2,2,... .\nThe first (NBKPT-NORD+3)*(NORD+1) entries of W(*) are acceptable as direct input to DFC for an \"old problem\" only when MDEOUT=1 or 2 . Calls proc~~defc~~CallsGraph proc~defc bspline_defc_module::defc proc~defcmn bspline_defc_module::defcmn proc~defc->proc~defcmn proc~dbndac bspline_defc_module::dbndac proc~defcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~defcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~defcmn->proc~dcopy proc~dfspvn bspline_defc_module::dfspvn proc~defcmn->proc~dfspvn proc~dscal bspline_blas_module::dscal proc~defcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~defcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine defc ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , & Mdeout , Coeff , Lw , w ) integer , intent ( in ) :: Ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), dimension ( ndata ), intent ( in ) :: Xdata !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), dimension ( ndata ), intent ( in ) :: Ydata !! Y data array. real ( wp ), dimension ( ndata ), intent ( in ) :: Sddata !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: Nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension (:), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: Mdein !! An integer flag, with one of two possible !! values (1 or 2), that directs the subprogram !! action with regard to new data points provided !! by the user: !! !! * `= 1` The first time that [[DEFC]] has been !! entered. There are NDATA points to process. !! * `= 2` This is another entry to DEFC(). The !! subprogram [[DEFC]] has been entered with MDEIN=1 !! exactly once before for this problem. There !! are NDATA new additional points to merge and !! process with any previous points. !! (When using [[DEFC]] with MDEIN=2 it is !! important that the set of knots remain fixed at the !! same values for all entries to [[DEFC]].) integer , intent ( out ) :: Mdeout !! An output flag that indicates the status !! of the curve fit: !! !! * `=-1` A usage error of [[DEFC]] occurred. The !! offending condition is noted with the SLATEC !! library error processor, `XERMSG( )`. In case !! the working array `W(*)` is not long enough, the !! minimal acceptable length is printed. !! !! * `=1` The B-spline coefficients for the fitted !! curve have been returned in array `COEFF(*)`. !! !! * `=2` Not enough data has been processed to !! determine the B-spline coefficients. !! The user has one of two options. Continue !! to process more data until a unique set !! of coefficients is obtained, or use the !! subprogram [[DFC]] to obtain a specific !! set of coefficients. The user should read !! the usage instructions for [[DFC]] for further !! details if this second option is chosen. real ( wp ), intent ( out ) :: Coeff ( * ) !! If the output value of `MDEOUT=1`, this array !! contains the unknowns obtained from the least !! squares fitting process. These `N=NBKPT-NORD` !! parameters are the B-spline coefficients. !! For `MDEOUT=2`, not enough data was processed to !! uniquely determine the B-spline coefficients. !! In this case, and also when `MDEOUT=-1`, all !! values of `COEFF(*)` are set to zero. !! !! If the user is not satisfied with the fitted !! curve returned by [[DEFC]], the constrained !! least squares curve fitting subprogram [[DFC]] !! may be required. The work done within [[DEFC]] !! to accumulate the data can be utilized by !! the user, if so desired. This involves !! saving the first `(NBKPT-NORD+3)*(NORD+1)` !! entries of `W(*)` and providing this data !! to [[DFC]] with the \"old problem\" designation. !! The user should read the usage instructions !! for subprogram [[DFC]] for further details. integer , intent ( in ) :: Lw !! The amount of working storage actually !! allocated for the working array `W(*)`. !! This quantity is compared with the !! actual amount of storage needed in [[DEFC]]. !! Insufficient storage allocated for `W(*)` is !! an error. This feature was included in [[DEFC]] !! because misreading the storage formula !! for `W(*)` might very well lead to subtle !! and hard-to-find programming bugs. !! !! The length of the array `W(*)` must satisfy !!``` !! LW >= (NBKPT-NORD+3)*(NORD+1)+ !! (NBKPT+1)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` real ( wp ) :: w ( * ) !! Working Array. !! Its length is specified as an input parameter !! in `LW` as noted above. The contents of `W(*)` !! must not be modified by the user between calls !! to [[DEFC]] with values of `MDEIN=1,2,2,...` . !! The first `(NBKPT-NORD+3)*(NORD+1)` entries of !! `W(*)` are acceptable as direct input to [[DFC]] !! for an \"old problem\" only when `MDEOUT=1` or `2`. integer :: lbf , lbkpt , lg , lptemp , lww , lxtemp , mdg , mdw ! LWW=1 USAGE IN DEFCMN( ) OF W(*).. ! LWW,...,LG-1 W(*,*) ! LG,...,LXTEMP-1 G(*,*) ! LXTEMP,...,LPTEMP-1 XTEMP(*) ! LPTEMP,...,LBKPT-1 PTEMP(*) ! LBKPT,...,LBF BKPT(*) (LOCAL TO DEFCMN( )) ! LBF,...,LBF+NORD**2 BF(*,*) mdg = Nbkpt + 1 mdw = Nbkpt - Nord + 3 lww = 1 lg = lww + mdw * ( Nord + 1 ) lxtemp = lg + mdg * ( Nord + 1 ) lptemp = lxtemp + max ( Ndata , Nbkpt ) lbkpt = lptemp + max ( Ndata , Nbkpt ) lbf = lbkpt + Nbkpt call defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , Mdeout , & Coeff , w ( lbf ), w ( lxtemp ), w ( lptemp ), w ( lbkpt ), w ( lg ), mdg , & w ( lww ), mdw , Lw ) end subroutine defc","tags":"","loc":"proc/defc.html"},{"title":"defcmn – bspline-fortran","text":"private subroutine defcmn(Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkptin, Mdein, Mdeout, Coeff, Bf, Xtemp, Ptemp, Bkpt, g, Mdg, w, Mdw, Lw) This is a companion subprogram to DEFC .\n This subprogram does weighted least squares fitting of data by\n B-spline curves.\n The documentation for DEFC has complete usage instructions. Revision history 800801 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900328 Added TYPE section. (WRB) 900510 Convert XERRWV calls to XERMSG calls. (RWC) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer :: Ndata real(kind=wp) :: Xdata (*) real(kind=wp) :: Ydata (*) real(kind=wp) :: Sddata (*) integer :: Nord integer :: Nbkpt real(kind=wp) :: Bkptin (*) integer :: Mdein integer :: Mdeout real(kind=wp) :: Coeff (*) real(kind=wp) :: Bf (Nord,*) real(kind=wp) :: Xtemp (*) real(kind=wp) :: Ptemp (*) real(kind=wp) :: Bkpt (*) real(kind=wp) :: g (Mdg,*) integer :: Mdg real(kind=wp) :: w (Mdw,*) integer :: Mdw integer :: Lw Calls proc~~defcmn~~CallsGraph proc~defcmn bspline_defc_module::defcmn proc~dbndac bspline_defc_module::dbndac proc~defcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~defcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~defcmn->proc~dcopy proc~dfspvn bspline_defc_module::dfspvn proc~defcmn->proc~dfspvn proc~dscal bspline_blas_module::dscal proc~defcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~defcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~defcmn~~CalledByGraph proc~defcmn bspline_defc_module::defcmn proc~defc bspline_defc_module::defc proc~defc->proc~defcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkptin , & Mdein , Mdeout , Coeff , Bf , Xtemp , Ptemp , Bkpt , g , Mdg , w , & Mdw , Lw ) integer :: Lw , Mdein , Mdeout , Mdg , Mdw , Nbkpt , Ndata , Nord real ( wp ) :: Bf ( Nord , * ), Bkpt ( * ), Bkptin ( * ), Coeff ( * ), & g ( Mdg , * ), Ptemp ( * ), Sddata ( * ), w ( Mdw , * ), & Xdata ( * ), Xtemp ( * ), Ydata ( * ) real ( wp ) :: rnorm , xmax , xmin , xval integer :: i , idata , ileft , intseq , ip , ir , irow , l , mt , n , & nb , nordm1 , nordp1 , np1 character ( len = 8 ) :: xern1 , xern2 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Initialize variables and analyze input. n = Nbkpt - Nord np1 = n + 1 ! Initially set all output coefficients to zero. call dcopy ( n , [ 0.0_wp ], 0 , Coeff , 1 ) Mdeout = - 1 if ( Nord < 1 . or . Nord > 20 ) then write ( * , * ) 'IN DEFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' return end if if ( Nbkpt < 2 * Nord ) then write ( * , * ) 'IN DEFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE THE B-SPLINE ORDER.' return end if if ( Ndata < 0 ) then write ( * , * ) 'IN DEFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' return end if nb = ( Nbkpt - Nord + 3 ) * ( Nord + 1 ) + ( Nbkpt + 1 ) * ( Nord + 1 ) & + 2 * max ( Nbkpt , Ndata ) + Nbkpt + Nord ** 2 if ( Lw < nb ) then write ( xern1 , '(I8)' ) nb write ( xern2 , '(I8)' ) Lw write ( * , * ) 'IN DEFC, INSUFFICIENT STORAGE FOR W(*). CHECK FORMULA ' // & 'THAT READS LW>= ... . NEED = ' // xern1 // & ' GIVEN = ' // xern2 Mdeout = - 1 return end if if ( Mdein /= 1 . and . Mdein /= 2 ) then write ( * , * ) 'IN DEFC, INPUT VALUE OF MDEIN MUST BE 1-2.' return end if ! Sort the breakpoints. call dcopy ( Nbkpt , Bkptin , 1 , Bkpt , 1 ) call dsort ( Nbkpt , 1 , Bkpt ) ! Save interval containing knots. xmin = Bkpt ( Nord ) xmax = Bkpt ( np1 ) nordm1 = Nord - 1 nordp1 = Nord + 1 ! Process least squares equations. ! Sort data and an array of pointers. call dcopy ( Ndata , Xdata , 1 , Xtemp , 1 ) do i = 1 , Ndata Ptemp ( i ) = i end do ! JW : really Ptemp should be an integer array. ! it is real because they are stuffing it in ! a real work array and also using dsort on it. if ( Ndata > 0 ) then call dsort ( Ndata , 2 , Xtemp , Ptemp ) xmin = min ( xmin , Xtemp ( 1 )) xmax = max ( xmax , Xtemp ( Ndata )) end if ! Fix breakpoint array if needed. This should only involve very ! minor differences with the input array of breakpoints. do i = 1 , Nord Bkpt ( i ) = min ( Bkpt ( i ), xmin ) end do do i = np1 , Nbkpt Bkpt ( i ) = max ( Bkpt ( i ), xmax ) end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = Nord intseq = 1 do idata = 1 , Ndata ! Sorted indices are in PTEMP(*). l = int ( Ptemp ( idata )) xval = Xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= Bkpt ( ileft + 1 )) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ILEFT<=N. do ileft = ileft , n if ( xval < Bkpt ( ileft + 1 )) exit if ( Mdein == 2 ) then ! Data is being sequentially accumulated. ! Transfer previously accumulated rows from W(*,*) to ! G(*,*) and process them. call dcopy ( nordp1 , w ( intseq , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , intseq ) intseq = intseq + 1 end if end do end if ! Obtain B-spline function value. call dfspvn ( Bkpt , Nord , 1 , xval , ileft , Bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( Nord , Bf , 1 , g ( irow , 1 ), Mdg ) g ( irow , nordp1 ) = Ydata ( l ) ! Scale data if uncertainty is nonzero. if ( Sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / Sddata ( l ), g ( irow , 1 ), Mdg ) ! When staging work area is exhausted, process rows. if ( irow == Mdg - 1 ) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 end if end do ! Process last block of equations. call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) ! Finish processing any previously accumulated rows from W(*,*) ! to G(*,*). if ( Mdein == 2 ) then do i = intseq , np1 call dcopy ( nordp1 , w ( i , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , min ( n , i )) end do end if ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , np1 ) ! Transfer accumulated rows from G(*,*) to W(*,*) for ! possible later sequential accumulation. do i = 1 , np1 call dcopy ( nordp1 , g ( i , 1 ), Mdg , w ( i , 1 ), Mdw ) end do ! Solve for coefficients when possible. do i = 1 , n if ( g ( i , 1 ) == 0.0_wp ) then Mdeout = 2 return end if end do ! All the diagonal terms in the accumulated triangular ! matrix are nonzero. The solution can be computed but ! it may be unsuitable for further use due to poor ! conditioning or the lack of constraints. No checking ! for either of these is done here. call dbndsl ( 1 , g , Mdg , Nord , ip , ir , Coeff , n , rnorm ) Mdeout = 1 end subroutine defcmn","tags":"","loc":"proc/defcmn.html"},{"title":"dbndac – bspline-fortran","text":"private subroutine dbndac(g, Mdg, Nb, Ip, Ir, Mt, Jt) These subroutines solve the least squares problem Ax = b for\n banded matrices A using sequential accumulation of rows of the\n data matrix. Exactly one right-hand side vector is permitted. These subroutines are intended for the type of least squares\n systems that arise in applications such as curve or surface\n fitting of data. The least squares equations are accumulated and\n processed using only part of the data. This requires a certain\n user interaction during the solution of Ax = b. Specifically, suppose the data matrix (A B) is row partitioned\n into Q submatrices. Let (E F) be the T-th one of these\n submatrices where E = (0 C 0). Here the dimension of E is MT by N\n and the dimension of C is MT by NB. The value of NB is the\n bandwidth of A. The dimensions of the leading block of zeros in E\n are MT by JT-1. The user of the subroutine DBNDAC provides MT,JT,C and F for\n T=1,...,Q. Not all of this data must be supplied at once. Following the processing of the various blocks (E F), the matrix\n (A B) has been transformed to the form (R D) where R is upper\n triangular and banded with bandwidth NB. The least squares\n system Rx = d is then easily solved using back substitution by\n executing the statement CALL DBNDSL(1,...). The sequence of\n values for JT must be nondecreasing. This may require some\n preliminary interchanges of rows and columns of the matrix A. The primary reason for these subroutines is that the total\n processing can take place in a working array of dimension MU by\n NB+1. An acceptable value for MU is MU = MAX(MT + N + 1), where N is the number of unknowns. Here the maximum is taken over all values of MT for T=1,...,Q.\n Notice that MT can be taken to be a small as one, showing that\n MU can be as small as N+2. The subprogram DBNDAC processes the\n rows more efficiently if MU is large enough so that each new\n block (C F) has a distinct value of JT. The four principle parts of these algorithms are obtained by the\n following call statements: CALL [[DBNDAC]](...) Introduce new blocks of data. CALL [[DBNDSL]](1,...) Compute solution vector and length of\n residual vector. CALL [[DBNDSL]](2,...) Given any row vector H solve YR = H for the\n row vector Y. CALL [[DBNDSL]](3,...) Given any column vector W solve RZ = W for\n the column vector Z. Remarks To obtain the upper triangular matrix and transformed right-hand\n side vector D so that the super diagonals of R form the columns\n of G( , ), execute the following Fortran statements. nbp1 = nb + 1 do j = 1 , nbp1 g ( ir , j ) = 0.0 end do mt = 1 jt = n + 1 call dbndac ( g , mdg , nb , ip , ir , mt , jt ) References C. L. Lawson and R. J. Hanson, Solving Least Squares\n Problems, Prentice-Hall, Inc., 1974, Chapter 27. Revision history 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: g (Mdg,*) G(MDG,NB+1) Input The working array into which the user will\nplace the MT by NB+1 block (C F) in rows IR through IR+MT-1 , columns 1 through NB+1 .\nSee descriptions of IR and MT below. Output The working array which will contain the\nprocessed rows of that part of the data\nmatrix which has been passed to DBNDAC . integer, intent(in) :: Mdg The number of rows in the working array G(*,*) . The value of MDG should be >= MU .\nThe value of MU is defined in the abstract\nof these subprograms. integer, intent(in) :: Nb The bandwidth of the data matrix A . integer, intent(inout) :: Ip Input Set by the user to the value 1 before the\nfirst call to DBNDAC . Its subsequent value\nis controlled by DBNDAC to set up for the\nnext call to DBNDAC . Output The value of this argument is advanced by DBNDAC to be ready for storing and processing\na new block of data in G(*,*) . integer, intent(inout) :: Ir Input Index of the row of G(*,*) where the user is\nto place the new block of data (C F) . Set by\nthe user to the value 1 before the first call\nto DBNDAC . Its subsequent value is controlled\nby DBNDAC . A value of IR > MDG is considered\nan error. Output The value of this argument is advanced by DBNDAC to be ready for storing and processing\na new block of data in G(*,*) . integer, intent(in) :: Mt Set by the user to indicate the\nnumber of new rows of data in the block integer, intent(in) :: Jt Set by the user to indicate\nthe index of the first nonzero column in that\nset of rows (E F) = (0 C 0 F) being processed. Calls proc~~dbndac~~CallsGraph proc~dbndac bspline_defc_module::dbndac proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dbndac~~CalledByGraph proc~dbndac bspline_defc_module::dbndac proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dbndac proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbndac ( g , Mdg , Nb , Ip , Ir , Mt , Jt ) implicit none integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of MDG should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. real ( wp ), intent ( inout ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! *Input* !! The working array into which the user will !! place the `MT` by `NB+1` block `(C F)` in rows `IR` !! through `IR+MT-1`, columns 1 through `NB+1`. !! See descriptions of `IR` and `MT` below. !! !! *Output* !! The working array which will contain the !! processed rows of that part of the data !! matrix which has been passed to [[DBNDAC]]. integer , intent ( in ) :: Nb !! The bandwidth of the data matrix `A`. integer , intent ( inout ) :: Ip !! *Input* !! Set by the user to the value 1 before the !! first call to [[DBNDAC]]. Its subsequent value !! is controlled by [[DBNDAC]] to set up for the !! next call to [[DBNDAC]]. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( inout ) :: Ir !! *Input* !! Index of the row of `G(*,*)` where the user is !! to place the new block of data `(C F)`. Set by !! the user to the value 1 before the first call !! to [[DBNDAC]]. Its subsequent value is controlled !! by [[DBNDAC]]. A value of `IR > MDG` is considered !! an error. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( in ) :: Mt !! Set by the user to indicate the !! number of new rows of data in the block integer , intent ( in ) :: Jt !! Set by the user to indicate !! the index of the first nonzero column in that !! set of rows `(E F) = (0 C 0 F)` being processed. real ( wp ) :: rho integer :: i , ie , ig , ig1 , ig2 , iopt , j , jg , & k , kh , l , lp1 , mh , mu , nbp1 , nerr real ( wp ), parameter :: zero = 0.0_wp ! ALG. STEPS 1-4 ARE PERFORMED EXTERNAL TO THIS SUBROUTINE. nbp1 = Nb + 1 if ( Mt <= 0 . or . Nb <= 0 ) return if (. not . Mdg < Ir ) then if ( Jt /= Ip ) then if ( Jt > Ir ) then do i = 1 , Mt ig1 = Jt + Mt - i ig2 = Ir + Mt - i do j = 1 , nbp1 g ( ig1 , j ) = g ( ig2 , j ) end do end do ie = Jt - Ir do i = 1 , ie ig = Ir + i - 1 do j = 1 , nbp1 g ( ig , j ) = zero end do end do Ir = Jt end if mu = min ( Nb - 1 , Ir - Ip - 1 ) if ( mu /= 0 ) then do l = 1 , mu k = min ( l , Jt - Ip ) lp1 = l + 1 ig = Ip + l do i = lp1 , Nb jg = i - k g ( ig , jg ) = g ( ig , i ) end do do i = 1 , k jg = nbp1 - i g ( ig , jg ) = zero end do end do end if Ip = Jt end if mh = Ir + Mt - Ip kh = min ( nbp1 , mh ) do i = 1 , kh call dh12 ( 1 , i , max ( i + 1 , Ir - Ip + 1 ), mh , g ( Ip , i ), 1 , & rho , g ( Ip , i + 1 ), 1 , Mdg , nbp1 - i ) end do Ir = Ip + kh if ( kh >= nbp1 ) then do i = 1 , Nb g ( Ir - 1 , i ) = zero end do end if else nerr = 1 iopt = 2 write ( * , * ) 'MDG= MU .\nThe value of MU is defined in the abstract\nof these subprograms. This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Nb This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ip This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ir This argument has the same meaning and\ncontents as following the last call to DBNDAC . real(kind=wp), intent(inout) :: x (*) X(N) Input With mode=2 or 3 this array contains,\nrespectively, the right-side vectors H or W of\nthe systems YR = H or RZ = W. Output This array contains the solution vectors X , Y or Z of the systems AX = B , YR = H or RZ = W depending on the value of MODE =1,\n2 or 3. integer, intent(in) :: n The number of variables in the solution\nvector. If any of the N diagonal terms are\nzero the subroutine DBNDSL prints an\nappropriate message. This condition is\nconsidered an error. real(kind=wp), intent(out) :: Rnorm If MODE=1 , RNORM is the Euclidean length of the\nresidual vector AX-B . When MODE=2 or 3 RNORM`\nis set to zero. Called by proc~~dbndsl~~CalledByGraph proc~dbndsl bspline_defc_module::dbndsl proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndsl proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dbndsl proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dbndsl ( Mode , g , Mdg , Nb , Ip , Ir , x , n , Rnorm ) integer , intent ( in ) :: Mode !! Set by the user to one of the values 1, 2, or !! 3. These values respectively indicate that !! the solution of `AX = B`, `YR = H` or `RZ = W` is !! required. integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of `MDG` should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( in ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Nb !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ip !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ir !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( inout ) :: x ( * ) !! `X(N)` !! !! *Input* With mode=2 or 3 this array contains, !! respectively, the right-side vectors H or W of !! the systems YR = H or RZ = W. !! !! *Output* This array contains the solution vectors `X`, !! `Y` or `Z` of the systems `AX = B`, `YR = H` or !! `RZ = W` depending on the value of `MODE`=1, !! 2 or 3. integer , intent ( in ) :: n !! The number of variables in the solution !! vector. If any of the `N` diagonal terms are !! zero the subroutine [[DBNDSL]] prints an !! appropriate message. This condition is !! considered an error. real ( wp ), intent ( out ) :: Rnorm !! If `MODE=1`, `RNORM` is the Euclidean length of the !! residual vector `AX-B`. When `MODE=2` or `3` RNORM` !! is set to zero. real ( wp ) :: rsq , s integer :: i , i1 , i2 , ie , ii , iopt , irm1 , ix , j , & jg , l , nerr , np1 real ( wp ), parameter :: zero = 0.0_wp main : block Rnorm = zero select case ( Mode ) case ( 1 ) ! ALG. STEP 26 do j = 1 , n x ( j ) = g ( j , Nb + 1 ) end do rsq = zero np1 = n + 1 irm1 = Ir - 1 if ( np1 <= irm1 ) then do j = np1 , irm1 rsq = rsq + g ( j , Nb + 1 ) ** 2 end do Rnorm = sqrt ( rsq ) end if case ( 2 ) do j = 1 , n s = zero if ( j /= 1 ) then i1 = max ( 1 , j - Nb + 1 ) i2 = j - 1 do i = i1 , i2 l = j - i + 1 + max ( 0 , i - Ip ) s = s + x ( i ) * g ( i , l ) end do end if l = max ( 0 , j - Ip ) if ( g ( j , l + 1 ) == 0 ) exit main x ( j ) = ( x ( j ) - s ) / g ( j , l + 1 ) end do return end select ! MODE = 3 do ii = 1 , n i = n + 1 - ii s = zero l = max ( 0 , i - Ip ) if ( i /= n ) then ie = min ( n + 1 - i , Nb ) do j = 2 , ie jg = j + l ix = i - 1 + j s = s + g ( i , jg ) * x ( ix ) end do end if if ( g ( i , l + 1 ) == 0 ) exit main x ( i ) = ( x ( i ) - s ) / g ( i , l + 1 ) end do return end block main ! error handling nerr = 1 iopt = 2 write ( * , * ) 'A zero diagonal term is in the n by n upper triangular matrix.' end subroutine dbndsl","tags":"","loc":"proc/dbndsl.html"},{"title":"dfspvn – bspline-fortran","text":"private subroutine dfspvn(t, Jhigh, Index, x, Ileft, Vnikx, j, deltam, deltap) Calculates the value of all possibly nonzero B-splines at X of\n order MAX(JHIGH,(J+1)(INDEX-1)) on T . Revision history 780801 DATE WRITTEN 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) JW : made threadsafe. See also dbspvn Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: t (*) integer, intent(in) :: Jhigh integer, intent(in) :: Index real(kind=wp), intent(in) :: x integer, intent(in) :: Ileft real(kind=wp) :: Vnikx (*) integer, intent(inout) :: j JW : added real(kind=wp), intent(inout), dimension(20) :: deltam JW : added real(kind=wp), intent(inout), dimension(20) :: deltap JW : added Called by proc~~dfspvn~~CalledByGraph proc~dfspvn bspline_defc_module::dfspvn proc~dcv bspline_defc_module::dcv proc~dcv->proc~dfspvn proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dfspvn proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dfspvn proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn->proc~dfspvd proc~dfspvd->proc~dfspvn proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfspvn ( t , Jhigh , Index , x , Ileft , Vnikx , j , deltam , deltap ) real ( wp ), intent ( in ) :: t ( * ) integer , intent ( in ) :: Jhigh integer , intent ( in ) :: Index real ( wp ), intent ( in ) :: x integer , intent ( in ) :: Ileft real ( wp ) :: Vnikx ( * ) integer , intent ( inout ) :: j !! JW : added real ( wp ), dimension ( 20 ), intent ( inout ) :: deltam , deltap !! JW : added real ( wp ) :: vm , vmprev integer :: imjp1 , ipj , jp1 , jp1ml , l if ( Index /= 2 ) then j = 1 Vnikx ( 1 ) = 1.0_wp if ( j >= Jhigh ) return end if do ipj = Ileft + j deltap ( j ) = t ( ipj ) - x imjp1 = Ileft - j + 1 deltam ( j ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = j + 1 do l = 1 , j jp1ml = jp1 - l vm = Vnikx ( l ) / ( deltap ( l ) + deltam ( jp1ml )) Vnikx ( l ) = vm * deltap ( l ) + vmprev vmprev = vm * deltam ( jp1ml ) end do Vnikx ( jp1 ) = vmprev j = jp1 if ( j >= Jhigh ) exit end do end subroutine dfspvn","tags":"","loc":"proc/dfspvn.html"},{"title":"dh12 – bspline-fortran","text":"private subroutine dh12(Mode, Lpivot, l1, m, u, Iue, Up, c, Ice, Icv, Ncv) Construction and/or application of a single\n Householder transformation. Q = I + U*(U**T)/B Reference C.L.Lawson and R.J.Hanson, Jet Propulsion Laboratory, 1973 Jun 12\n to appear in 'Solving Least Squares Problems', Prentice-Hall, 1974 Revision history 790101 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890831 Modified array declarations. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 900911 Added DDOT to real(wp) statement. (WRB) Arguments Type Intent Optional Attributes Name integer, intent(in) :: Mode 1 or 2 to select algorithm H1 or H2 . integer, intent(in) :: Lpivot the index of the pivot element. integer, intent(in) :: l1 If L1 <= M the transformation will be constructed to\nzero elements indexed from L1 through M . If L1 > M the subroutine does an identity transformation. integer, intent(in) :: m see l1 real(kind=wp), intent(inout) :: u (Iue,*) On entry to H1 U() contains the pivot vector.\nOn exit from H1 U() and UP contain quantities defining the vector U of the\nHouseholder transformation. On entry to H2 U() and UP should contain quantities previously computed\nby H1. These will not be modified by H2. integer, intent(in) :: Iue the storage increment between elements of U . real(kind=wp), intent(inout) :: Up see u real(kind=wp), intent(inout) :: c (*) On entry to H1 or H2 C() contains a matrix which will be\nregarded as a set of vectors to which the Householder\ntransformation is to be applied. On exit C() contains the\nset of transformed vectors. integer, intent(in) :: Ice Storage increment between elements of vectors in C() . integer, intent(in) :: Icv Storage increment between vectors in C() . integer, intent(in) :: Ncv Number of vectors in C() to be transformed. If NCV <= 0 no operations will be done on C() . Calls proc~~dh12~~CallsGraph proc~dh12 bspline_defc_module::dh12 proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dh12~~CalledByGraph proc~dh12 bspline_defc_module::dh12 proc~dbndac bspline_defc_module::dbndac proc~dbndac->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dhfti->proc~dh12 proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dlsi->proc~dh12 proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dh12 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dwnlit proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dbndac proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dbndac proc~dfcmn->proc~dlsei proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn proc~dlpdp->proc~dwnnls Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dh12 ( Mode , Lpivot , l1 , m , u , Iue , Up , c , Ice , Icv , Ncv ) integer , intent ( in ) :: Mode !! 1 or 2 to select algorithm H1 or H2 . integer , intent ( in ) :: Lpivot !! the index of the pivot element. integer , intent ( in ) :: l1 !! If `L1 <= M` the transformation will be constructed to !! zero elements indexed from `L1` through `M`. If `L1 > M` !! the subroutine does an identity transformation. integer , intent ( in ) :: m !! see `l1` integer , intent ( in ) :: Iue !! the storage increment between elements of `U`. real ( wp ), intent ( inout ) :: u ( Iue , * ) !! On entry to H1 `U()` contains the pivot vector. !! On exit from H1 `U()` and `UP` !! contain quantities defining the vector `U` of the !! Householder transformation. On entry to H2 `U()` !! and `UP` should contain quantities previously computed !! by H1. These will not be modified by H2. real ( wp ), intent ( inout ) :: Up !! see `u` real ( wp ), intent ( inout ) :: c ( * ) !! On entry to H1 or H2 `C()` contains a matrix which will be !! regarded as a set of vectors to which the Householder !! transformation is to be applied. On exit `C()` contains the !! set of transformed vectors. integer , intent ( in ) :: Ice !! Storage increment between elements of vectors in `C()`. integer , intent ( in ) :: Icv !! Storage increment between vectors in `C()`. integer , intent ( in ) :: Ncv !! Number of vectors in `C()` to be transformed. If `NCV <= 0` !! no operations will be done on `C()`. integer :: i , i2 , i3 , i4 , incr , j , kl1 , & kl2 , klp , l1m1 , mml1p2 real ( wp ) :: b , cl , clinv , ul1m1 , sm real ( wp ), parameter :: one = 1.0_wp if ( 0 < Lpivot . and . Lpivot < l1 . and . l1 <= m ) then cl = abs ( u ( 1 , Lpivot )) if ( Mode /= 2 ) then ! ****** CONSTRUCT THE TRANSFORMATION. ****** do j = l1 , m cl = max ( abs ( u ( 1 , j )), cl ) end do if ( cl <= 0.0_wp ) return clinv = one / cl sm = ( u ( 1 , Lpivot ) * clinv ) ** 2 do j = l1 , m sm = sm + ( u ( 1 , j ) * clinv ) ** 2 end do cl = cl * sqrt ( sm ) if ( u ( 1 , Lpivot ) > 0.0_wp ) cl = - cl Up = u ( 1 , Lpivot ) - cl u ( 1 , Lpivot ) = cl ! ****** APPLY THE TRANSFORMATION I+U*(U**T)/B TO C. ****** elseif ( cl <= 0.0_wp ) then return end if if ( Ncv > 0 ) then b = Up * u ( 1 , Lpivot ) ! B MUST BE NONPOSITIVE HERE. IF B = 0., RETURN. if ( b < 0.0_wp ) then b = one / b mml1p2 = m - l1 + 2 if ( mml1p2 <= 20 ) then i2 = 1 - Icv + Ice * ( Lpivot - 1 ) incr = Ice * ( l1 - Lpivot ) do j = 1 , Ncv i2 = i2 + Icv i3 = i2 + incr i4 = i3 sm = c ( i2 ) * Up do i = l1 , m sm = sm + c ( i3 ) * u ( 1 , i ) i3 = i3 + Ice end do if ( sm /= 0.0_wp ) then sm = sm * b c ( i2 ) = c ( i2 ) + sm * Up do i = l1 , m c ( i4 ) = c ( i4 ) + sm * u ( 1 , i ) i4 = i4 + Ice end do end if end do else l1m1 = l1 - 1 kl1 = 1 + ( l1m1 - 1 ) * Ice kl2 = kl1 klp = 1 + ( Lpivot - 1 ) * Ice ul1m1 = u ( 1 , l1m1 ) u ( 1 , l1m1 ) = Up if ( Lpivot /= l1m1 ) call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) do j = 1 , Ncv sm = ddot ( mml1p2 , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) sm = sm * b call daxpy ( mml1p2 , sm , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) kl1 = kl1 + Icv end do u ( 1 , l1m1 ) = ul1m1 if ( Lpivot /= l1m1 ) then kl1 = kl2 call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) end if end if end if end if end if end subroutine dh12","tags":"","loc":"proc/dh12.html"},{"title":"dsort – bspline-fortran","text":"private subroutine dsort(n, Kflag, Dx, Dy) Sort an array and optionally make the same interchanges in\n an auxiliary array. The array may be sorted in increasing\n or decreasing order. History 29-dec-2022 : Replaced original routines.\n Now just a wraper for sort_ascending recursive quicksort (JW) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n number of values in array DX to be sorted integer, intent(in) :: Kflag control parameter:\n * Kflag < 0 : sort DX in decreasing order and optionally carry DY along.\n * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real(kind=wp), intent(inout), dimension(*) :: Dx array of values to be sorted (usually abscissas) real(kind=wp), intent(inout), optional, dimension(*) :: Dy array to be (optionally) carried along Calls proc~~dsort~~CallsGraph proc~dsort bspline_defc_module::dsort proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dsort~~CalledByGraph proc~dsort bspline_defc_module::dsort proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dsort proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dsort proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dsort ( n , Kflag , Dx , Dy ) implicit none integer , intent ( in ) :: n !! number of values in array DX to be sorted integer , intent ( in ) :: Kflag !! control parameter: !! * Kflag < 0 : sort DX in decreasing order and optionally carry DY along. !! * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real ( wp ), dimension ( * ), intent ( inout ) :: Dx !! array of values to be sorted (usually abscissas) real ( wp ), dimension ( * ), intent ( inout ), optional :: Dy !! array to be (optionally) carried along if ( n < 1 ) then write ( * , * ) 'The number of values to be sorted is not positive.' return end if if ( abs ( Kflag ) == 0 ) then write ( * , * ) 'The sort control parameter, K, cannot be 0.' return end if ! Alter array DX to get decreasing order if needed if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) call sort_ascending ( n , Dx , Dy ) if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) end subroutine dsort","tags":"","loc":"proc/dsort.html"},{"title":"sort_ascending – bspline-fortran","text":"private subroutine sort_ascending(n, dx, dy) Recursive quicksoft.\n Modified to also carry along a second array. Author Jacob Williams Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=wp), intent(inout), dimension(*) :: dx array of values to be sorted real(kind=wp), intent(inout), optional, dimension(*) :: dy array to be (optionally) carried along Called by proc~~sort_ascending~~CalledByGraph proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort bspline_defc_module::dsort proc~dsort->proc~sort_ascending proc~defcmn bspline_defc_module::defcmn proc~defcmn->proc~dsort proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dsort proc~defc bspline_defc_module::defc proc~defc->proc~defcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine sort_ascending ( n , dx , dy ) integer , intent ( in ) :: n real ( wp ), dimension ( * ), intent ( inout ) :: dx !! array of values to be sorted real ( wp ), dimension ( * ), intent ( inout ), optional :: dy !! array to be (optionally) carried along logical :: carry_dy !! if `dy` is to be also sorted integer , parameter :: max_size_for_insertion_sort = 20 !! max size for using insertion sort. !! (otherwise, use quicksort) carry_dy = present ( dy ) call quicksort ( 1 , n ) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array (ascending order). integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer :: ipivot !! pivot element integer :: i !! counter integer :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( dx ( j ) < dx ( j - 1 )) then call swap ( dx ( j ), dx ( j - 1 )) if ( carry_dy ) call swap ( dy ( j ), dy ( j - 1 )) else exit end if end do end do else if ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1 ) call quicksort ( ipivot + 1 , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer , intent ( out ) :: ipivot integer :: i , ip , im im = ( ilow + ihigh ) / 2 call swap ( dx ( ilow ), dx ( im )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( im )) ip = ilow do i = ilow + 1 , ihigh if ( dx ( i ) < dx ( ilow )) then ip = ip + 1 call swap ( dx ( ip ), dx ( i )) if ( carry_dy ) call swap ( dy ( ip ), dy ( i )) end if end do call swap ( dx ( ilow ), dx ( ip )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( ip )) ipivot = ip end subroutine partition subroutine swap ( v1 , v2 ) !! swap two real values real ( wp ), intent ( inout ) :: v1 real ( wp ), intent ( inout ) :: v2 real ( wp ) :: tmp tmp = v1 v1 = v2 v2 = tmp end subroutine swap end subroutine sort_ascending","tags":"","loc":"proc/sort_ascending.html"},{"title":"dfc – bspline-fortran","text":"public subroutine dfc(ndata, xdata, ydata, sddata, nord, Nbkpt, Bkpt, nconst, xconst, yconst, nderiv, mode, coeff, w, iw) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense.\n Equality and inequality constraints can be imposed on the\n fitted curve. Evaluating the Variance Function To evaluate the variance function (assuming\n that the uncertainties of the Y values were\n provided to DFC and an input value of\n MODE=2 or 4 was used), use the function\n subprogram DCV var = dcv ( xval , ndata , nconst , nord , nbkpt , bkpt , w ) Here XVAL is the point where the variance is\n desired. The other arguments have the same\n meaning as in the usage of DFC . For those users employing the old problem\n designation, let MDATA be the number of data\n points in the problem. (This may be different\n from NDATA if the old problem designation\n feature was used.) The value, VAR, should be\n multiplied by the quantity DBLE(MAX(NDATA-N,1))/DBLE(MAX(MDATA-N,1)) The output of this subprogram is not defined\n if an input value of MODE=1 or 3 was used in\n FC( ) or if an output value of MODE=-1, 2, or\n 3 was obtained. The variance function, except\n for the scaling factor noted above, is given\n by VAR=(transpose of B(XVAL))*C*B(XVAL) The vector B(XVAL) is the B-spline basis\n function values at X=XVAL.\n The covariance matrix, C, of the solution\n coefficients accounts only for the least\n squares equations and the explicitly stated\n equality constraints. This fact must be\n considered when interpreting the variance\n function from a data fitting problem that has\n inequality constraints on the fitted curve. Evaluating the Fitted Curve Refer to the defc header Revision history 780801 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900510 Convert references to XERRWV to references to XERMSG. (RWC) 900607 Editorial changes to Prologue to make Prologues for EFC,\n DEFC, FC, and DFC look as much the same as possible. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name integer, intent(in) :: ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in) :: xdata (*) X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in) :: ydata (*) Y data array. real(kind=wp), intent(in) :: sddata (*) Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(*) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: nconst The number of conditions that constrain the\nB-spline is NCONST. A constraint is specified\nby an (X,Y) pair in the arrays XCONST( ) and\nYCONST( ), and by the type of constraint and\nderivative value encoded in the array\nNDERIV(*). real(kind=wp), intent(in) :: xconst (*) X value of constraint.\nNo sorting of XCONST(*) is required. real(kind=wp), intent(in) :: yconst (*) Y value of constraint integer, intent(in) :: nderiv (*) The value of NDERIV(*) is\n determined as follows. Suppose the I-th\n constraint applies to the J-th derivative\n of the B-spline. (Any non-negative value of\n J < NORD is permitted. In particular the\n value J=0 refers to the B-spline itself.)\n For this I-th constraint, set XCONST(I)=X,\n YCONST(I)=Y, and\n NDERIV(I)=ITYPE+4*J, where\n\n ITYPE = 0, if (J-th deriv. at X) <= Y.\n = 1, if (J-th deriv. at X) >= Y.\n = 2, if (J-th deriv. at X) == Y.\n = 3, if (J-th deriv. at X) ==\n (J-th deriv. at Y). (A value of NDERIV(I)=-1 will cause this\n constraint to be ignored. This subprogram\n feature is often useful when temporarily\n suppressing a constraint while still\n retaining the source code of the calling\n program.) integer, intent(inout) :: mode Input An input flag that directs the least squares\nsolution method used by DFC . The variance function, referred to below,\ndefines the square of the probable error of\nthe fitted curve at any point, XVAL.\nThis feature of DFC allows one to use the\nsquare root of this variance function to\ndetermine a probable error band around the\nfitted curve. =1 a new problem. No variance function. =2 a new problem. Want variance function. =3 an old problem. No variance function. =4 an old problem. Want variance function. Any value of MODE other than 1-4 is an error. The user with a new problem can skip directly\nto the description of the input parameters\nIW(1), IW(2). If the user correctly specifies the new or old\nproblem status, the subprogram DFC will\nperform more efficiently.\nBy an old problem it is meant that subprogram DFC was last called with this same set of\nknots, data points and weights. Another often useful deployment of this old\nproblem designation can occur when one has\npreviously obtained a Q-R orthogonal\ndecomposition of the matrix resulting from\nB-spline fitting of data (without constraints)\nat the breakpoints BKPT(I), I=1,...,NBKPT.\nFor example, this matrix could be the result\nof sequential accumulation of the least\nsquares equations for a very large data set.\nThe user writes this code in a manner\nconvenient for the application. For the\ndiscussion here let N=NBKPT-NORD, and K=N+3 Let us assume that an equivalent least squares\nsystem RC=D has been obtained. Here R is an N+1 by N\nmatrix and D is a vector with N+1 components.\nThe last row of R is zero. The matrix R is\nupper triangular and banded. At most NORD of\nthe diagonals are nonzero.\nThe contents of R and D can be copied to the\nworking array W(*) as follows. The I-th diagonal of R, which has N-I+1\nelements, is copied to W(*) starting at W((I-1)*K+1), for I=1,...,NORD.\nThe vector D is copied to W(*) starting at W(NORD*K+1) The input value used for NDATA is arbitrary\nwhen an old problem is designated. Because\nof the feature of DFC that checks the\nworking storage array lengths, a value not\nexceeding NBKPT should be used. For example,\nuse NDATA=0. (The constraints or variance function request\ncan change in each call to DFC .) A new\nproblem is anything other than an old problem. Output An output flag that indicates the status\nof the constrained curve fit. =-1 a usage error of DFC occurred. The\n offending condition is noted with the\n SLATEC library error processor, XERMSG.\n In case the working arrays W( ) or IW( )\n are not long enough, the minimal\n acceptable length is printed. = 0 successful constrained curve fit. = 1 the requested equality constraints\n are contradictory. = 2 the requested inequality constraints\n are contradictory. = 3 both equality and inequality constraints\n are contradictory. real(kind=wp), intent(out) :: coeff (*) If the output value of MODE=0 or 1, this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD\nparameters are the B-spline coefficients.\nFor MODE=1, the equality constraints are\ncontradictory. To make the fitting process\nmore robust, the equality constraints are\nsatisfied in a least squares sense. In this\ncase the array COEFF( ) contains B-spline\ncoefficients for this extended concept of a\nsolution. If MODE=-1,2 or 3 on output, the\narray COEFF( ) is undefined. real(kind=wp) :: w (*) real work array of length IW(1) . The\n contents of W(*) must not be modified by the\n user if the variance function is desired. The length of W(*) must be at least NB=(NBKPT-NORD+3)*(NORD+1)+\n 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 Whenever possible the code uses banded matrix\n processors DBNDAC( ) and DBNDSL( ). These\n are utilized if there are no constraints,\n no variance function is required, and there\n is sufficient data to uniquely determine the\n B-spline coefficients. If the band processors\n cannot be used to determine the solution,\n then the constrained least squares code DLSEI\n is used. In this case the subprogram requires\n an additional block of storage in W(*). For\n the discussion here define the integers NEQCON\n and NINCON respectively as the number of\n equality (ITYPE=2,3) and inequality\n (ITYPE=0,1) constraints imposed on the fitted\n curve. Define L = NBKPT-NORD+1 and note that NCONST = NEQCON+NINCON When the subprogram DFC uses DLSEI the\n length of the working array W(*) must be at\n least LW = NB+(L+NCONST)*L+2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6) integer :: iw (*) integer work array of length IW(2) IW(1),IW(2) are the amounts of working storage actually\nallocated for the working arrays W( ) and\nIW( ). These quantities are compared with the\nactual amounts of storage needed in DFC .\nInsufficient storage allocated for either\nW( ) or IW( ) is an error. This feature was\nincluded in DFC because misreading the\nstorage formulas for W( ) and IW( ) might very\nwell lead to subtle and hard-to-find\nprogramming bugs. The length of the array IW(*) must be at least IW1 = NINCON+2*L in any case. Calls proc~~dfc~~CallsGraph proc~dfc bspline_defc_module::dfc proc~dfcmn bspline_defc_module::dfcmn proc~dfc->proc~dfcmn proc~daxpy bspline_blas_module::daxpy proc~dfcmn->proc~daxpy proc~dbndac bspline_defc_module::dbndac proc~dfcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~dfcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~dfcmn->proc~dcopy proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn->proc~dfspvd proc~dfspvn bspline_defc_module::dfspvn proc~dfcmn->proc~dfspvn proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dscal bspline_blas_module::dscal proc~dfcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~dfcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~dfspvd->proc~dfspvn proc~dlsei->proc~daxpy proc~dlsei->proc~dcopy proc~dlsei->proc~dscal proc~dasum bspline_blas_module::dasum proc~dlsei->proc~dasum proc~ddot bspline_blas_module::ddot proc~dlsei->proc~ddot proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dnrm2 bspline_blas_module::dnrm2 proc~dlsei->proc~dnrm2 proc~dswap bspline_blas_module::dswap proc~dlsei->proc~dswap proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dlsi->proc~daxpy proc~dlsi->proc~dcopy proc~dlsi->proc~dscal proc~dlsi->proc~dasum proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dswap proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~dscal proc~dlpdp->proc~ddot proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dasum proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dswap proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dscal proc~dwnlit->proc~dh12 proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfc ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , & nconst , xconst , yconst , nderiv , mode , coeff , w , iw ) integer , intent ( in ) :: ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), intent ( in ) :: xdata ( * ) !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), intent ( in ) :: ydata ( * ) !! Y data array. real ( wp ), intent ( in ) :: sddata ( * ) !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension ( * ), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: nconst !! The number of conditions that constrain the !! B-spline is NCONST. A constraint is specified !! by an (X,Y) pair in the arrays XCONST(*) and !! YCONST(*), and by the type of constraint and !! derivative value encoded in the array !! NDERIV(*). real ( wp ), intent ( in ) :: xconst ( * ) !! X value of constraint. !! No sorting of XCONST(*) is required. real ( wp ), intent ( in ) :: yconst ( * ) !! Y value of constraint integer , intent ( in ) :: nderiv ( * ) !! The value of NDERIV(*) is !! determined as follows. Suppose the I-th !! constraint applies to the J-th derivative !! of the B-spline. (Any non-negative value of !! J < NORD is permitted. In particular the !! value J=0 refers to the B-spline itself.) !! For this I-th constraint, set !!``` !! XCONST(I)=X, !! YCONST(I)=Y, and !! NDERIV(I)=ITYPE+4*J, where !! !! ITYPE = 0, if (J-th deriv. at X) <= Y. !! = 1, if (J-th deriv. at X) >= Y. !! = 2, if (J-th deriv. at X) == Y. !! = 3, if (J-th deriv. at X) == !! (J-th deriv. at Y). !!``` !! (A value of NDERIV(I)=-1 will cause this !! constraint to be ignored. This subprogram !! feature is often useful when temporarily !! suppressing a constraint while still !! retaining the source code of the calling !! program.) integer , intent ( inout ) :: mode !! *Input* !! !! An input flag that directs the least squares !! solution method used by [[DFC]]. !! !! The variance function, referred to below, !! defines the square of the probable error of !! the fitted curve at any point, XVAL. !! This feature of [[DFC]] allows one to use the !! square root of this variance function to !! determine a probable error band around the !! fitted curve. !! !! * `=1` a new problem. No variance function. !! * `=2` a new problem. Want variance function. !! * `=3` an old problem. No variance function. !! * `=4` an old problem. Want variance function. !! !! Any value of MODE other than 1-4 is an error. !! !! The user with a new problem can skip directly !! to the description of the input parameters !! IW(1), IW(2). !! !! If the user correctly specifies the new or old !! problem status, the subprogram [[DFC]] will !! perform more efficiently. !! By an old problem it is meant that subprogram !! [[DFC]] was last called with this same set of !! knots, data points and weights. !! !! Another often useful deployment of this old !! problem designation can occur when one has !! previously obtained a Q-R orthogonal !! decomposition of the matrix resulting from !! B-spline fitting of data (without constraints) !! at the breakpoints BKPT(I), I=1,...,NBKPT. !! For example, this matrix could be the result !! of sequential accumulation of the least !! squares equations for a very large data set. !! The user writes this code in a manner !! convenient for the application. For the !! discussion here let !! !! `N=NBKPT-NORD, and K=N+3` !! !! Let us assume that an equivalent least squares !! system !! !! `RC=D` !! !! has been obtained. Here R is an N+1 by N !! matrix and D is a vector with N+1 components. !! The last row of R is zero. The matrix R is !! upper triangular and banded. At most NORD of !! the diagonals are nonzero. !! The contents of R and D can be copied to the !! working array W(*) as follows. !! !! The I-th diagonal of R, which has N-I+1 !! elements, is copied to W(*) starting at !! !! `W((I-1)*K+1),` !! !! for I=1,...,NORD. !! The vector D is copied to W(*) starting at !! !! `W(NORD*K+1)` !! !! The input value used for NDATA is arbitrary !! when an old problem is designated. Because !! of the feature of [[DFC]] that checks the !! working storage array lengths, a value not !! exceeding NBKPT should be used. For example, !! use NDATA=0. !! !! (The constraints or variance function request !! can change in each call to [[DFC]].) A new !! problem is anything other than an old problem. !! !! *Output* !! !! An output flag that indicates the status !! of the constrained curve fit. !! !! * `=-1` a usage error of [[DFC]] occurred. The !! offending condition is noted with the !! SLATEC library error processor, XERMSG. !! In case the working arrays W(*) or IW(*) !! are not long enough, the minimal !! acceptable length is printed. !! * `= 0` successful constrained curve fit. !! * `= 1` the requested equality constraints !! are contradictory. !! * `= 2` the requested inequality constraints !! are contradictory. !! * `= 3` both equality and inequality constraints !! are contradictory. real ( wp ), intent ( out ) :: coeff ( * ) !! If the output value of MODE=0 or 1, this array !! contains the unknowns obtained from the least !! squares fitting process. These N=NBKPT-NORD !! parameters are the B-spline coefficients. !! For MODE=1, the equality constraints are !! contradictory. To make the fitting process !! more robust, the equality constraints are !! satisfied in a least squares sense. In this !! case the array COEFF(*) contains B-spline !! coefficients for this extended concept of a !! solution. If MODE=-1,2 or 3 on output, the !! array COEFF(*) is undefined. real ( wp ) :: w ( * ) !! real work array of length `IW(1)`. The !! contents of `W(*)` must not be modified by the !! user if the variance function is desired. !! !! The length of W(*) must be at least !!``` !! NB=(NBKPT-NORD+3)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` !! Whenever possible the code uses banded matrix !! processors DBNDAC( ) and DBNDSL( ). These !! are utilized if there are no constraints, !! no variance function is required, and there !! is sufficient data to uniquely determine the !! B-spline coefficients. If the band processors !! cannot be used to determine the solution, !! then the constrained least squares code DLSEI !! is used. In this case the subprogram requires !! an additional block of storage in W(*). For !! the discussion here define the integers NEQCON !! and NINCON respectively as the number of !! equality (ITYPE=2,3) and inequality !! (ITYPE=0,1) constraints imposed on the fitted !! curve. Define !! !! `L = NBKPT-NORD+1` !! !! and note that !! !! `NCONST = NEQCON+NINCON` !! !! When the subprogram [[DFC]] uses [[DLSEI]] the !! length of the working array W(*) must be at !! least !! !! `LW = NB+(L+NCONST)*L+2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6)` integer :: iw ( * ) !! integer work array of length `IW(2)` !! !! `IW(1),IW(2)` are the amounts of working storage actually !! allocated for the working arrays W(*) and !! IW(*). These quantities are compared with the !! actual amounts of storage needed in [[DFC]]. !! Insufficient storage allocated for either !! W(*) or IW(*) is an error. This feature was !! included in [[DFC]] because misreading the !! storage formulas for W(*) and IW(*) might very !! well lead to subtle and hard-to-find !! programming bugs. !! !! The length of the array IW(*) must be at least !! !! `IW1 = NINCON+2*L` !! !! in any case. integer :: i1 , i2 , i3 , i4 , i5 , i6 , i7 , mdg , mdw mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst ! USAGE IN DFCMN( ) OF W(*).. ! I1,...,I2-1 G(*,*) ! I2,...,I3-1 XTEMP(*) ! I3,...,I4-1 PTEMP(*) ! I4,...,I5-1 BKPT(*) (LOCAL TO [[DFCMN]]) ! I5,...,I6-1 BF(*,*) ! I6,...,I7-1 W(*,*) ! I7,... WORK(*) FOR [[DLSEI]] i1 = 1 i2 = i1 + mdg * ( nord + 1 ) i3 = i2 + max ( ndata , nbkpt ) i4 = i3 + max ( ndata , nbkpt ) i5 = i4 + nbkpt i6 = i5 + nord * nord i7 = i6 + mdw * ( nbkpt - nord + 1 ) call dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , nconst , & xconst , yconst , nderiv , mode , coeff , w ( i5 ), w ( i2 ), w ( i3 ), & w ( i4 ), w ( i1 ), mdg , w ( i6 ), mdw , w ( i7 ), iw ) end subroutine dfc","tags":"","loc":"proc/dfc.html"},{"title":"dfcmn – bspline-fortran","text":"private subroutine dfcmn(ndata, xdata, ydata, sddata, nord, nbkpt, bkptin, nconst, xconst, yconst, nderiv, mode, coeff, bf, xtemp, ptemp, bkpt, g, mdg, w, mdw, work, iwork) This is a companion subprogram to DFC .\n The documentation for DFC has complete usage instructions. Revision history 780801 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900328 Added TYPE section. (WRB) 900510 Convert XERRWV calls to XERMSG calls. (RWC) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer :: ndata real(kind=wp) :: xdata (*) real(kind=wp) :: ydata (*) real(kind=wp) :: sddata (*) integer :: nord integer :: nbkpt real(kind=wp) :: bkptin (*) integer :: nconst real(kind=wp) :: xconst (*) real(kind=wp) :: yconst (*) integer :: nderiv (*) integer :: mode real(kind=wp) :: coeff (*) real(kind=wp) :: bf (nord,*) real(kind=wp) :: xtemp (*) real(kind=wp) :: ptemp (*) real(kind=wp) :: bkpt (*) real(kind=wp) :: g (mdg,*) integer :: mdg real(kind=wp) :: w (mdw,*) integer :: mdw real(kind=wp) :: work (*) integer :: iwork (*) Calls proc~~dfcmn~~CallsGraph proc~dfcmn bspline_defc_module::dfcmn proc~daxpy bspline_blas_module::daxpy proc~dfcmn->proc~daxpy proc~dbndac bspline_defc_module::dbndac proc~dfcmn->proc~dbndac proc~dbndsl bspline_defc_module::dbndsl proc~dfcmn->proc~dbndsl proc~dcopy bspline_blas_module::dcopy proc~dfcmn->proc~dcopy proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn->proc~dfspvd proc~dfspvn bspline_defc_module::dfspvn proc~dfcmn->proc~dfspvn proc~dlsei bspline_defc_module::dlsei proc~dfcmn->proc~dlsei proc~dscal bspline_blas_module::dscal proc~dfcmn->proc~dscal proc~dsort bspline_defc_module::dsort proc~dfcmn->proc~dsort proc~dh12 bspline_defc_module::dh12 proc~dbndac->proc~dh12 proc~dfspvd->proc~dfspvn proc~dlsei->proc~daxpy proc~dlsei->proc~dcopy proc~dlsei->proc~dscal proc~dasum bspline_blas_module::dasum proc~dlsei->proc~dasum proc~ddot bspline_blas_module::ddot proc~dlsei->proc~ddot proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dnrm2 bspline_blas_module::dnrm2 proc~dlsei->proc~dnrm2 proc~dswap bspline_blas_module::dswap proc~dlsei->proc~dswap proc~sort_ascending bspline_defc_module::sort_ascending proc~dsort->proc~sort_ascending proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dlsi->proc~daxpy proc~dlsi->proc~dcopy proc~dlsi->proc~dscal proc~dlsi->proc~dasum proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dswap proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~dscal proc~dlpdp->proc~ddot proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dasum proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dswap proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dscal proc~dwnlit->proc~dh12 proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dfcmn~~CalledByGraph proc~dfcmn bspline_defc_module::dfcmn proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , & bkptin , nconst , xconst , yconst , nderiv , mode , coeff , bf , xtemp , & ptemp , bkpt , g , mdg , w , mdw , work , iwork ) integer :: iwork ( * ), mdg , mdw , mode , nbkpt , nconst , ndata , nderiv ( * ), & nord real ( wp ) :: bf ( nord , * ), bkpt ( * ), bkptin ( * ), coeff ( * ), & g ( mdg , * ), ptemp ( * ), sddata ( * ), w ( mdw , * ), work ( * ), & xconst ( * ), xdata ( * ), xtemp ( * ), yconst ( * ), ydata ( * ) real ( wp ) :: prgopt ( 10 ), rnorm , rnorme , rnorml , xmax , & xmin , xval , yval integer :: i , idata , ideriv , ileft , intrvl , intw1 , ip , ir , irow , & itype , iw1 , iw2 , l , lw , mt , n , nb , neqcon , nincon , nordm1 , & nordp1 , np1 logical :: band , new , var character ( len = 8 ) :: xern1 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Analyze input. if ( nord < 1 . or . nord > 20 ) then write ( * , * ) 'IN DFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' mode = - 1 return elseif ( nbkpt < 2 * nord ) then write ( * , * ) 'IN DFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE ' // & 'THE B-SPLINE ORDER.' mode = - 1 return endif if ( ndata < 0 ) then write ( * , * ) 'IN DFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' mode = - 1 return endif ! Amount of storage allocated for W(*), IW(*). iw1 = iwork ( 1 ) iw2 = iwork ( 2 ) nb = ( nbkpt - nord + 3 ) * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + & nord ** 2 ! See if sufficient storage has been allocated. if ( iw1 < nb ) then write ( xern1 , '(I8)' ) nb write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK NB = ' // xern1 mode = - 1 return endif select case ( mode ) case ( 1 ) band = . true . var = . false . new = . true . case ( 2 ) band = . false . var = . true . new = . true . case ( 3 ) band = . true . var = . false . new = . false . case ( 4 ) band = . false . var = . true . new = . false . case default write ( * , * ) 'IN DFC, INPUT VALUE OF MODE MUST BE 1-4.' mode = - 1 return end select mode = 0 ! Sort the breakpoints. call dcopy ( nbkpt , bkptin , 1 , bkpt , 1 ) call dsort ( nbkpt , 1 , bkpt ) ! Initialize variables. neqcon = 0 nincon = 0 do i = 1 , nconst l = nderiv ( i ) itype = mod ( l , 4 ) if ( itype < 2 ) then nincon = nincon + 1 else neqcon = neqcon + 1 endif end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Compute the number of variables. n = nbkpt - nord np1 = n + 1 lw = nb + ( np1 + nconst ) * np1 + 2 * ( neqcon + np1 ) + ( nincon + np1 ) + & ( nincon + 2 ) * ( np1 + 6 ) intw1 = nincon + 2 * np1 ! Save interval containing knots. xmin = bkpt ( nord ) xmax = bkpt ( np1 ) ! Find the smallest referenced independent variable value in any ! constraint. do i = 1 , nconst xmin = min ( xmin , xconst ( i )) xmax = max ( xmax , xconst ( i )) end do nordm1 = nord - 1 nordp1 = nord + 1 ! Define the option vector PRGOPT(1-10) for use in [[DLSEI]]. prgopt ( 1 ) = 4 ! Set the covariance matrix computation flag. prgopt ( 2 ) = 1 if ( var ) then prgopt ( 3 ) = 1 else prgopt ( 3 ) = 0 endif ! Increase the rank determination tolerances for both equality ! constraint equations and least squares equations. prgopt ( 4 ) = 7 prgopt ( 5 ) = 4 prgopt ( 6 ) = 1.0e-4_wp prgopt ( 7 ) = 10 prgopt ( 8 ) = 5 prgopt ( 9 ) = 1.0e-4_wp prgopt ( 10 ) = 1 ! Turn off work array length checking in [[DLSEI]]. iwork ( 1 ) = 0 iwork ( 2 ) = 0 ! Initialize variables and analyze input. if ( new ) then ! To process least squares equations sort data and an array of ! pointers. call dcopy ( ndata , xdata , 1 , xtemp , 1 ) do i = 1 , ndata ptemp ( i ) = i end do if ( ndata > 0 ) then call dsort ( ndata , 2 , xtemp , ptemp ) xmin = min ( xmin , xtemp ( 1 )) xmax = max ( xmax , xtemp ( ndata )) endif ! Fix breakpoint array if needed. do i = 1 , nord bkpt ( i ) = min ( bkpt ( i ), xmin ) end do do i = np1 , nbkpt bkpt ( i ) = max ( bkpt ( i ), xmax ) end do ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = nord do idata = 1 , ndata ! Sorted indices are in PTEMP(*). l = ptemp ( idata ) xval = xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= bkpt ( ileft + 1 )) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ! ILEFT= bkpt ( ileft + 1 ) . and . ileft < n ) then ileft = ileft + 1 else exit endif end do endif ! Obtain B-spline function value. call dfspvn ( bkpt , nord , 1 , xval , ileft , bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( nord , bf , 1 , g ( irow , 1 ), mdg ) g ( irow , nordp1 ) = ydata ( l ) ! Scale data if uncertainty is nonzero. if ( sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / sddata ( l ), & g ( irow , 1 ), mdg ) ! When staging work area is exhausted, process rows. if ( irow == mdg - 1 ) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 endif end do ! Process last block of equations. call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), mdg ) call dbndac ( g , mdg , nord , ip , ir , 1 , np1 ) endif band = band . and . nconst == 0 do i = 1 , n band = band . and . g ( i , 1 ) /= 0.0_wp end do ! Process banded least squares equations. if ( band ) then call dbndsl ( 1 , g , mdg , nord , ip , ir , coeff , n , rnorm ) return endif ! Check further for sufficient storage in working arrays. if ( iw1 < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK LW = ' // xern1 mode = - 1 return endif if ( iw2 < intw1 ) then write ( xern1 , '(I8)' ) intw1 write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR IW(*). CHECK IW1 = ' // xern1 mode = - 1 return endif ! Write equality constraints. ! Analyze constraint indicators for an equality constraint. neqcon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype > 1 ) then ideriv = l / 4 neqcon = neqcon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) call dcopy ( np1 , [ 0.0_wp ], 0 , w ( neqcon , 1 ), mdw ) call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( neqcon , ileft - nordm1 ), & mdw ) if ( itype == 2 ) then w ( neqcon , np1 ) = yconst ( idata ) else ileft = nord yval = yconst ( idata ) do if ( yval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , yval , ileft , bf , ideriv + 1 ) call daxpy ( nord , - 1.0_wp , bf ( 1 , ideriv + 1 ), 1 , & w ( neqcon , ileft - nordm1 ), mdw ) endif endif end do ! Transfer least squares data. do i = 1 , np1 irow = i + neqcon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) call dcopy ( min ( np1 - i , nord ), g ( i , 1 ), mdg , w ( irow , i ), mdw ) w ( irow , np1 ) = g ( i , nordp1 ) end do ! Write inequality constraints. ! Analyze constraint indicators for inequality constraints. nincon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype < 2 ) then ideriv = l / 4 nincon = nincon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) irow = neqcon + np1 + nincon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) intrvl = ileft - nordm1 call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( irow , intrvl ), mdw ) if ( itype == 1 ) then w ( irow , np1 ) = yconst ( idata ) else w ( irow , np1 ) = - yconst ( idata ) call dscal ( nord , - 1.0_wp , w ( irow , intrvl ), mdw ) endif endif end do ! Solve constrained least squares equations. call dlsei ( w , mdw , neqcon , np1 , nincon , n , prgopt , coeff , rnorme , & rnorml , mode , work , iwork ) end subroutine dfcmn","tags":"","loc":"proc/dfcmn.html"},{"title":"dfspvd – bspline-fortran","text":"private subroutine dfspvd(t, k, x, ileft, vnikx, nderiv) Calculates value and derivs of all B-splines which do not vanish at X Fill VNIKX(J,IDERIV), J=IDERIV, ... ,K with nonzero values of\n B-splines of order K+1-IDERIV , IDERIV=NDERIV, ... ,1 , by repeated\n calls to DFSPVN Revision history 780801 DATE WRITTEN 890531 Changed all specific intrinsics to generic. (WRB) 890831 Modified array declarations. (WRB) 890911 Removed unnecessary intrinsics. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: t (*) integer :: k real(kind=wp) :: x integer :: ileft real(kind=wp) :: vnikx (k,*) integer :: nderiv Calls proc~~dfspvd~~CallsGraph proc~dfspvd bspline_defc_module::dfspvd proc~dfspvn bspline_defc_module::dfspvn proc~dfspvd->proc~dfspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dfspvd~~CalledByGraph proc~dfspvd bspline_defc_module::dfspvd proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dfspvd proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dfspvd ( t , k , x , ileft , vnikx , nderiv ) real ( wp ) :: t ( * ) integer :: k real ( wp ) :: x integer :: ileft real ( wp ) :: vnikx ( k , * ) integer :: nderiv real ( wp ) :: a ( 20 , 20 ) integer :: ideriv , idervm , i , j , kmd , m , jm1 , ipkmd , l , jlow real ( wp ) :: fkmd , diff , v integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp call dfspvn ( t , k + 1 - nderiv , 1 , x , ileft , vnikx ( nderiv , nderiv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) if ( nderiv <= 1 ) return ideriv = nderiv do i = 2 , nderiv idervm = ideriv - 1 do j = ideriv , k vnikx ( j - 1 , idervm ) = vnikx ( j , ideriv ) end do ideriv = idervm call dfspvn ( t , 0 , 2 , x , ileft , vnikx ( ideriv , ideriv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) end do do i = 1 , k do j = 1 , k a ( i , j ) = 0.0_wp end do a ( i , i ) = 1.0_wp end do kmd = k do m = 2 , nderiv kmd = kmd - 1 fkmd = kmd i = ileft j = k do jm1 = j - 1 ipkmd = i + kmd diff = t ( ipkmd ) - t ( i ) if ( jm1 == 0 ) exit if ( diff /= 0.0_wp ) then do l = 1 , j a ( l , j ) = ( a ( l , j ) - a ( l , j - 1 )) / diff * fkmd end do end if j = jm1 i = i - 1 end do if ( diff /= 0.0_wp ) then a ( 1 , 1 ) = a ( 1 , 1 ) / diff * fkmd end if do i = 1 , k v = 0.0_wp jlow = max ( i , m ) do j = jlow , k v = a ( i , j ) * vnikx ( j , m ) + v end do vnikx ( i , m ) = v end do end do end subroutine dfspvd","tags":"","loc":"proc/dfspvd.html"},{"title":"dhfti – bspline-fortran","text":"private subroutine dhfti(a, mda, m, n, b, mdb, nb, tau, krank, rnorm, h, g, ip) Solve a least squares problem for banded matrices using\n sequential accumulation of rows of the data matrix.\n Exactly one right-hand side vector is permitted. This subroutine solves a linear least squares problem or a set of\n linear least squares problems having the same matrix but different\n right-side vectors. The problem data consists of an M by N matrix\n A, an M by NB matrix B, and an absolute tolerance parameter TAU\n whose usage is described below. The NB column vectors of B\n represent right-side vectors for NB distinct linear least squares\n problems. This set of problems can also be written as the matrix least\n squares problem A = B , where X is the N by NB solution matrix. Note that if B is the M by M identity matrix, then X will be the\n pseudo-inverse of A. This subroutine first transforms the augmented matrix (A B) to a\n matrix (R C) using premultiplying Householder transformations with\n column interchanges. All subdiagonal elements in the matrix R are\n zero and its diagonal elements satisfy abs(r(i,i))>=abs(r(i+1,i+1)),\n i = 1,...,l-1, where\n l = min(m,n). The subroutine will compute an integer, KRANK, equal to the number\n of diagonal terms of R that exceed TAU in magnitude. Then a\n solution of minimum Euclidean length is computed using the first\n KRANK rows of (R C). To be specific we suggest that the user consider an easily\n computable matrix norm, such as, the maximum of all column sums of\n magnitudes. Now if the relative uncertainty of B is EPS, (norm of uncertainty/\n norm of B), it is suggested that TAU be set approximately equal to\n EPS*(norm of A). References C. L. Lawson and R. J. Hanson, Solving Least Squares\n Problems, Prentice-Hall, Inc., 1974, Chapter 14. Revision history 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891006 Cosmetic changes to prologue. (WRB) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 901005 Replace usage of DDIFF with usage of D1MACH. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: a (mda,*) A(MDA,N) .\nThe array A( , ) initially contains the M by N\nmatrix A of the least squares problem AX = B.\nThe first dimensioning parameter of the array\nA( , ) is MDA, which must satisfy MDA>=M\nEither M>=N or M0\nthe array B( ) must initially contain the M by\nNB matrix B of the least squares problem AX =\nB. If NB>=2 the array B( ) must be doubly\nsubscripted with first dimensioning parameter\nMDB>=MAX(M,N). If NB = 1 the array B( ) may\nbe either doubly or singly subscripted. In\nthe latter case the value of MDB is arbitrary\nbut it should be set to some valid integer\nvalue such as MDB = M. The condition of NB>1.AND.MDB< MAX(M,N)\nis considered an error. On return the array B(*) will contain the N by\nNB solution matrix X. integer, intent(in) :: mdb actual leading dimension of b integer, intent(in) :: nb real(kind=wp), intent(in) :: tau Absolute tolerance parameter provided by user\nfor pseudorank determination. integer, intent(out) :: krank Set by the subroutine to indicate the\npseudorank of A. real(kind=wp), intent(out) :: rnorm (*) RNORM(NB) .\nOn return, RNORM(J) will contain the Euclidean\nnorm of the residual vector for the problem\ndefined by the J-th column vector of the array\nB( , ) for J = 1,...,NB. real(kind=wp) :: h (*) H(N) . Array of working space used by DHFTI.\nOn return, contains\nelements of the pre-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. real(kind=wp) :: g (*) G(N) . Array of working space used by DHFTI.\nOn return, contain\nelements of the post-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. integer :: ip (*) IP(N) . Array of working space used by DHFTI.\nArray in which the subroutine records indices\ndescribing the permutation of column vectors.\nnot generally required by the user. Calls proc~~dhfti~~CallsGraph proc~dhfti bspline_defc_module::dhfti proc~dh12 bspline_defc_module::dh12 proc~dhfti->proc~dh12 proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dswap bspline_blas_module::dswap proc~dh12->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dhfti~~CalledByGraph proc~dhfti bspline_defc_module::dhfti proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dhfti proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dhfti ( a , mda , m , n , b , mdb , nb , tau , krank , rnorm , h , g , ip ) integer , intent ( in ) :: mda !! actual leading dimension of `a` integer , intent ( in ) :: mdb !! actual leading dimension of `b` real ( wp ), intent ( inout ) :: a ( mda , * ) !! `A(MDA,N)`. !! The array A(*,*) initially contains the M by N !! matrix A of the least squares problem AX = B. !! The first dimensioning parameter of the array !! A(*,*) is MDA, which must satisfy MDA>=M !! Either M>=N or M0 !! the array B(*) must initially contain the M by !! NB matrix B of the least squares problem AX = !! B. If NB>=2 the array B(*) must be doubly !! subscripted with first dimensioning parameter !! MDB>=MAX(M,N). If NB = 1 the array B(*) may !! be either doubly or singly subscripted. In !! the latter case the value of MDB is arbitrary !! but it should be set to some valid integer !! value such as MDB = M. !! !! The condition of NB>1.AND.MDB< MAX(M,N) !! is considered an error. !! !! On return the array B(*) will contain the N by !! NB solution matrix X. integer , intent ( in ) :: nb real ( wp ), intent ( in ) :: tau !! Absolute tolerance parameter provided by user !! for pseudorank determination. integer , intent ( out ) :: krank !! Set by the subroutine to indicate the !! pseudorank of A. real ( wp ), intent ( out ) :: rnorm ( * ) !! `RNORM(NB)`. !! On return, RNORM(J) will contain the Euclidean !! norm of the residual vector for the problem !! defined by the J-th column vector of the array !! B(*,*) for J = 1,...,NB. real ( wp ) :: h ( * ) !! `H(N)`. Array of working space used by DHFTI. !! On return, contains !! elements of the pre-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. real ( wp ) :: g ( * ) !! `G(N)`. Array of working space used by DHFTI. !! On return, contain !! elements of the post-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. integer :: ip ( * ) !! `IP(N)`. Array of working space used by DHFTI. !! Array in which the subroutine records indices !! describing the permutation of column vectors. !! not generally required by the user. integer :: i , ii , iopt , ip1 , j , jb , jj , k , kp1 , l , ldiag , lmax , nerr real ( wp ) :: dzero , factor , hmax , sm , sm1 , szero , tmp logical :: lmax_found szero = 0.0_wp dzero = 0.0_wp factor = 0.001_wp k = 0 ldiag = min ( m , n ) if ( ldiag > 0 ) then if ( mda < m ) then nerr = 1 iopt = 2 write ( * , * ) 'MDA 1 . and . max ( m , n ) > mdb ) then nerr = 2 iopt = 2 write ( * , * ) 'MDB1. PROBABLE ERROR.' return end if do j = 1 , ldiag lmax_found = . false . if ( j /= 1 ) then ! UPDATE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = h ( l ) - a ( j - 1 , l ) ** 2 if ( h ( l ) > h ( lmax )) lmax = l end do lmax_found = ( factor * h ( lmax ) > hmax * drelpr ) end if if (. not . lmax_found ) then ! COMPUTE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = 0.0_wp do i = j , m h ( l ) = h ( l ) + a ( i , l ) ** 2 end do if ( h ( l ) > h ( lmax )) lmax = l end do hmax = h ( lmax ) end if ! LMAX HAS BEEN DETERMINED ! DO COLUMN INTERCHANGES IF NEEDED. ip ( j ) = lmax if ( ip ( j ) /= j ) then do i = 1 , m tmp = a ( i , j ) a ( i , j ) = a ( i , lmax ) a ( i , lmax ) = tmp end do h ( lmax ) = h ( j ) end if ! COMPUTE THE J-TH TRANSFORMATION AND APPLY IT TO A ! AND B. call dh12 ( 1 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), a ( 1 , j + 1 ), 1 , mda , n - j ) call dh12 ( 2 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), b , 1 , mdb , nb ) end do ! DETERMINE THE PSEUDORANK, K, USING THE TOLERANCE, TAU. do j = 1 , ldiag if ( abs ( a ( j , j )) <= tau ) then k = j - 1 exit else if ( j == ldiag ) k = ldiag end if end do kp1 = k + 1 ! COMPUTE THE NORMS OF THE RESIDUAL VECTORS. if ( nb >= 1 ) then do jb = 1 , nb tmp = szero if ( m >= kp1 ) then do i = kp1 , m tmp = tmp + b ( i , jb ) ** 2 end do end if rnorm ( jb ) = sqrt ( tmp ) end do end if ! SPECIAL FOR PSEUDORANK = 0 if ( k > 0 ) then ! IF THE PSEUDORANK IS LESS THAN N COMPUTE HOUSEHOLDER ! DECOMPOSITION OF FIRST K ROWS. if ( k /= n ) then do ii = 1 , k i = kp1 - ii call dh12 ( 1 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), a , mda , 1 , i - 1 ) end do end if if ( nb >= 1 ) then do jb = 1 , nb ! SOLVE THE K BY K TRIANGULAR SYSTEM. do l = 1 , k sm = dzero i = kp1 - l ip1 = i + 1 if ( k >= ip1 ) then do j = ip1 , k sm = sm + a ( i , j ) * b ( j , jb ) end do end if sm1 = sm b ( i , jb ) = ( b ( i , jb ) - sm1 ) / a ( i , i ) end do ! COMPLETE COMPUTATION OF SOLUTION VECTOR. if ( k /= n ) then do j = kp1 , n b ( j , jb ) = szero end do do i = 1 , k call dh12 ( 2 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), b ( 1 , jb ), 1 , mdb , 1 ) end do end if ! RE-ORDER THE SOLUTION VECTOR TO COMPENSATE FOR THE ! COLUMN INTERCHANGES. do jj = 1 , ldiag j = ldiag + 1 - jj if ( ip ( j ) /= j ) then l = ip ( j ) tmp = b ( l , jb ) b ( l , jb ) = b ( j , jb ) b ( j , jb ) = tmp end if end do end do end if elseif ( nb >= 1 ) then do jb = 1 , nb do i = 1 , n b ( i , jb ) = szero end do end do end if end if ! THE SOLUTION VECTORS, X, ARE NOW ! IN THE FIRST N ROWS OF THE ARRAY B(,). krank = k end subroutine dhfti","tags":"","loc":"proc/dhfti.html"},{"title":"dlpdp – bspline-fortran","text":"private subroutine dlpdp(a, mda, m, n1, n2, prgopt, x, wnorm, mode, ws, is) Determine an N1-vector W, and\n an N2-vector Z\n which minimizes the Euclidean length of W\n subject to G W+H Z >= Y.\n This is the least projected distance problem, LPDP.\n The matrices G and H are of respective\n dimensions M by N1 and M by N2. Called by subprogram DLSI . The matrix\n (G H Y)\n\n occupies rows 1,...,M and cols 1,...,N1+N2+1 of A(*,*).\n\n The solution (W) is returned in X(*).\n (Z) Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 910408 Updated the AUTHOR section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: a (mda,*) A(MDA,N+1) , where N=N1+N2 . integer, intent(in) :: mda integer :: m integer, intent(in) :: n1 integer, intent(in) :: n2 real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) X(N) , where N=N1+N2 . real(kind=wp) :: wnorm integer, intent(out) :: mode The value of MODE indicates the status of\nthe computation after returning to the user. MODE=1 The solution was successfully obtained. MODE=2 The inequalities are inconsistent. real(kind=wp) :: ws (*) WS((M+2)*(N+7)) , where N=N1+N2 . This is a slight overestimate for WS(*). integer :: is (*) IS(M+N+1) , where N=N1+N2 . Calls proc~~dlpdp~~CallsGraph proc~dlpdp bspline_defc_module::dlpdp proc~dcopy bspline_blas_module::dcopy proc~dlpdp->proc~dcopy proc~ddot bspline_blas_module::ddot proc~dlpdp->proc~ddot proc~dnrm2 bspline_blas_module::dnrm2 proc~dlpdp->proc~dnrm2 proc~dscal bspline_blas_module::dscal proc~dlpdp->proc~dscal proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dscal proc~dasum bspline_blas_module::dasum proc~dwnlsm->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dwnlsm->proc~daxpy proc~dh12 bspline_defc_module::dh12 proc~dwnlsm->proc~dh12 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dswap bspline_blas_module::dswap proc~dwnlsm->proc~dswap proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dh12->proc~ddot proc~dh12->proc~daxpy proc~dh12->proc~dswap proc~dwnlit->proc~dcopy proc~dwnlit->proc~dscal proc~dwnlit->proc~dh12 proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~dswap proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dlpdp~~CalledByGraph proc~dlpdp bspline_defc_module::dlpdp proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dlpdp ( a , mda , m , n1 , n2 , prgopt , x , wnorm , mode , ws , is ) integer , intent ( in ) :: mda integer :: m integer , intent ( in ) :: n1 integer , intent ( in ) :: n2 real ( wp ) :: a ( mda , * ) !! `A(MDA,N+1)`, where `N=N1+N2`. real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) !! `X(N)`, where `N=N1+N2`. real ( wp ) :: wnorm integer , intent ( out ) :: mode !! The value of MODE indicates the status of !! the computation after returning to the user. !! !! * `MODE=1` The solution was successfully obtained. !! * `MODE=2` The inequalities are inconsistent. real ( wp ) :: ws ( * ) !! `WS((M+2)*(N+7))`, where `N=N1+N2`. This is a slight overestimate for WS(*). integer :: is ( * ) !! `IS(M+N+1)`, where `N=N1+N2`. integer :: i , iw , ix , j , l , modew , n , np1 real ( wp ) :: rnorm , sc , ynorm real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: fac = 0.1_wp n = n1 + n2 mode = 1 if ( m <= 0 ) then if ( n > 0 ) then x ( 1 ) = zero call dcopy ( n , x , 0 , x , 1 ) end if wnorm = zero return end if np1 = n + 1 ! SCALE NONZERO ROWS OF INEQUALITY MATRIX TO HAVE LENGTH ONE. do i = 1 , m sc = dnrm2 ( n , a ( i , 1 ), mda ) if ( sc /= zero ) then sc = one / sc call dscal ( np1 , sc , a ( i , 1 ), mda ) end if end do ! SCALE RT.-SIDE VECTOR TO HAVE LENGTH ONE (OR ZERO). ynorm = dnrm2 ( m , a ( 1 , np1 ), 1 ) if ( ynorm /= zero ) then sc = one / ynorm call dscal ( m , sc , a ( 1 , np1 ), 1 ) end if ! SCALE COLS OF MATRIX H. j = n1 + 1 do if ( j > n ) exit sc = dnrm2 ( m , a ( 1 , j ), 1 ) if ( sc /= zero ) sc = one / sc call dscal ( m , sc , a ( 1 , j ), 1 ) x ( j ) = sc j = j + 1 end do if ( n1 > 0 ) then ! COPY TRANSPOSE OF (H G Y) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m ! MOVE COL OF TRANSPOSE OF H INTO WORK ARRAY. call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ! MOVE COL OF TRANSPOSE OF G INTO WORK ARRAY. call dcopy ( n1 , a ( i , 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n1 ! MOVE COMPONENT OF VECTOR Y INTO WORK ARRAY. ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n ws ( iw + 1 ) = one iw = iw + 1 ! SOLVE EU=F SUBJECT TO (TRANSPOSE OF H)U=0, U>=0. THE ! MATRIX E = TRANSPOSE OF (G Y), AND THE (N+1)-VECTOR ! F = TRANSPOSE OF (0,...,0,1). ix = iw + 1 iw = iw + m ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , np1 , n2 , np1 - n2 , m , 0 , prgopt , ws ( ix ), rnorm , & modew , is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY W. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n1 x ( j ) = sc * ddot ( m , a ( 1 , j ), 1 , ws ( ix ), 1 ) end do ! COMPUTE THE VECTOR Q=Y-GW. OVERWRITE Y WITH THIS ! VECTOR. do i = 1 , m a ( i , np1 ) = a ( i , np1 ) - ddot ( n1 , a ( i , 1 ), mda , x , 1 ) end do end if if ( n2 > 0 ) then ! COPY TRANSPOSE OF (H Q) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n2 , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = one iw = iw + 1 ix = iw + 1 iw = iw + m ! SOLVE RV=S SUBJECT TO V>=0. THE MATRIX R =(TRANSPOSE ! OF (H Q)), WHERE Q=Y-GW. THE (N2+1)-VECTOR S =(TRANSPOSE ! OF (0,...,0,1)). ! ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , n2 + 1 , 0 , n2 + 1 , m , 0 , prgopt , ws ( ix ), rnorm , modew , & is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY Z. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n2 l = n1 + j x ( l ) = sc * ddot ( m , a ( 1 , l ), 1 , ws ( ix ), 1 ) * x ( l ) end do end if ! ACCOUNT FOR SCALING OF RT.-SIDE VECTOR IN SOLUTION. call dscal ( n , ynorm , x , 1 ) wnorm = dnrm2 ( n1 , x , 1 ) end subroutine dlpdp","tags":"","loc":"proc/dlpdp.html"},{"title":"dlsei – bspline-fortran","text":"private subroutine dlsei(w, mdw, me, ma, mg, n, prgopt, x, rnorme, rnorml, mode, ws, ip) This subprogram solves a linearly constrained least squares\n problem with both equality and inequality constraints, and, if the\n user requests, obtains a covariance matrix of the solution\n parameters. Suppose there are given matrices E, A and G of respective\n dimensions ME by N, MA by N and MG by N, and vectors F, B and H of\n respective lengths ME, MA and MG. This subroutine solves the\n linearly constrained least squares problem EX = F, (E ME by N) (equations to be exactly satisfied) AX = B, (A MA by N) (equations to be approximately satisfied, least squares sense) GX >= H,(G MG by N) (inequality constraints) The inequalities GX >= H mean that every component of the\n product GX must be >= the corresponding component of H. In case the equality constraints cannot be satisfied, a\n generalized inverse solution residual vector length is obtained\n for F-EX. This is the minimal length possible for F-EX. Any values ME >= 0, MA >= 0, or MG >= 0 are permitted. The\n rank of the matrix E is estimated during the computation. We call\n this value KRANKE. It is an output parameter in IP(1) defined\n below. Using a generalized inverse solution of EX=F, a reduced\n least squares problem with inequality constraints is obtained.\n The tolerances used in these tests for determining the rank\n of E and the rank of the reduced least squares problem are\n given in Sandia Tech. Rept. SAND-78-1290. They can be\n modified by the user if new values are provided in\n the option list of the array PRGOPT(*). The user must dimension all arrays appearing in the call list..\n W(MDW,N+1),PRGOPT( ),X(N),WS(2 (ME+N)+K+(MG+2) (N+7)),IP(MG+2 N+2)\n where K=MAX(MA+MG,N). This allows for a solution of a range of\n problems in the given working space. The dimension of WS(*)\n given is a necessary overestimate. Once a particular problem\n has been run, the output parameter IP(3) gives the actual\n dimension required for that problem. The parameters for DLSEI are Input .. All TYPE REAL variables are DOUBLE PRECISION W ( * , * ), MDW , The array W ( * , * ) is doubly subscripted with ME , MA , MG , N first dimensioning parameter equal to MDW . For this discussion let us call M = ME + MA + MG . Then MDW must satisfy MDW >= M . The condition MDW < M is an error . The array W ( * , * ) contains the matrices and vectors ( E F ) ( A B ) ( G H ) in rows and columns 1 ,..., M and 1 ,..., N + 1 respectively . The integers ME , MA , and MG are the respective matrix row dimensions of E , A and G . Each matrix has N columns . PRGOPT ( * ) This real - valued array is the option vector . If the user is satisfied with the nominal subprogram features set PRGOPT ( 1 ) = 1 ( or PRGOPT ( 1 ) = 1.0 ) Otherwise PRGOPT ( * ) is a linked list consisting of groups of data of the following form LINK KEY DATA SET The parameters LINK and KEY are each one word . The DATA SET can be comprised of several words . The number of items depends on the value of KEY . The value of LINK points to the first entry of the next group of data within PRGOPT ( * ). The exception is when there are no more options to change . In that case , LINK = 1 and the values KEY and DATA SET are not referenced . The general layout of PRGOPT ( * ) is as follows . ... PRGOPT ( 1 ) = LINK1 ( link to first entry of next group ) . PRGOPT ( 2 ) = KEY1 ( key to the option change ) . PRGOPT ( 3 ) = data value ( data value for this change ) . . . . . . ... PRGOPT ( LINK1 ) = LINK2 ( link to the first entry of . next group ) . PRGOPT ( LINK1 + 1 ) = KEY2 ( key to the option change ) . PRGOPT ( LINK1 + 2 ) = data value ... . . . . . ... PRGOPT ( LINK ) = 1 ( no more options to change ) Values of LINK that are nonpositive are errors . A value of LINK > NLINK = 100000 is also an error . This helps prevent using invalid but positive values of LINK that will probably extend beyond the program limits of PRGOPT ( * ). Unrecognized values of KEY are ignored . The order of the options is arbitrary and any number of options can be changed with the following restriction . To prevent cycling in the processing of the option array , a count of the number of options changed is maintained . Whenever this count exceeds NOPT = 1000 , an error message is printed and the subprogram returns . Options .. KEY = 1 Compute in W ( * , * ) the N by N covariance matrix of the solution variables as an output parameter . Nominally the covariance matrix will not be computed . ( This requires no user input .) The data set for this option is a single value . It must be nonzero when the covariance matrix is desired . If it is zero , the covariance matrix is not computed . When the covariance matrix is computed , the first dimensioning parameter of the array W ( * , * ) must satisfy MDW >= MAX ( M , N ). KEY = 10 Suppress scaling of the inverse of the normal matrix by the scale factor RNORM ** 2 / MAX ( 1 , no . of degrees of freedom ). This option only applies when the option for computing the covariance matrix ( KEY = 1 ) is used . With KEY = 1 and KEY = 10 used as options the unscaled inverse of the normal matrix is returned in W ( * , * ). The data set for this option is a single value . When it is nonzero no scaling is done . When it is zero scaling is done . The nominal case is to do scaling so if option ( KEY = 1 ) is used alone , the matrix will be scaled on output . KEY = 2 Scale the nonzero columns of the entire data matrix . ( E ) ( A ) ( G ) to have length one . The data set for this option is a single value . It must be nonzero if unit length column scaling is desired . KEY = 3 Scale columns of the entire data matrix ( E ) ( A ) ( G ) with a user - provided diagonal matrix . The data set for this option consists of the N diagonal scaling factors , one for each matrix column . KEY = 4 Change the rank determination tolerance for the equality constraint equations from the nominal value of SQRT ( DRELPR ). This quantity can be no smaller than DRELPR , the arithmetic - storage precision . The quantity DRELPR is the largest positive number such that T = 1. + DRELPR satisfies T == 1. The quantity used here is internally restricted to be at least DRELPR . The data set for this option is the new tolerance . KEY = 5 Change the rank determination tolerance for the reduced least squares equations from the nominal value of SQRT ( DRELPR ). This quantity can be no smaller than DRELPR , the arithmetic - storage precision . The quantity used here is internally restricted to be at least DRELPR . The data set for this option is the new tolerance . For example , suppose we want to change the tolerance for the reduced least squares problem , compute the covariance matrix of the solution parameters , and provide column scaling for the data matrix . For these options the dimension of PRGOPT ( * ) must be at least N + 9. The Fortran statements defining these options would be as follows : PRGOPT ( 1 ) = 4 ( link to entry 4 in PRGOPT ( * )) PRGOPT ( 2 ) = 1 ( covariance matrix key ) PRGOPT ( 3 ) = 1 ( covariance matrix wanted ) PRGOPT ( 4 ) = 7 ( link to entry 7 in PRGOPT ( * )) PRGOPT ( 5 ) = 5 ( least squares equas . tolerance key ) PRGOPT ( 6 ) = ... ( new value of the tolerance ) PRGOPT ( 7 ) = N + 9 ( link to entry N + 9 in PRGOPT ( * )) PRGOPT ( 8 ) = 3 ( user - provided column scaling key ) CALL DCOPY ( N , D , 1 , PRGOPT ( 9 ), 1 ) ( Copy the N scaling factors from the user array D ( * ) to PRGOPT ( 9 ) - PRGOPT ( N + 8 )) PRGOPT ( N + 9 ) = 1 ( no more options to change ) The contents of PRGOPT ( * ) are not modified by the subprogram . The options for WNNLS ( ) can also be included in this array . The values of KEY recognized by WNNLS ( ) are 6 , 7 and 8. Their functions are documented in the usage instructions for subroutine WNNLS ( ). Normally these options do not need to be modified when using [ [DLSEI ] ] . IP ( 1 ), The amounts of working storage actually IP ( 2 ) allocated for the working arrays WS ( * ) and IP ( * ), respectively . These quantities are compared with the actual amounts of storage needed by [ [DLSEI ] ] . Insufficient storage allocated for either WS ( * ) or IP ( * ) is an error . This feature was included in [ [DLSEI ] ] because miscalculating the storage formulas for WS ( * ) and IP ( * ) might very well lead to subtle and hard - to - find execution errors . The length of WS ( * ) must be at least LW = 2 * ( ME + N ) + K + ( MG + 2 ) * ( N + 7 ) where K = max ( MA + MG , N ) This test will not be made if IP ( 1 ) <= 0. The length of IP ( * ) must be at least LIP = MG + 2 * N + 2 This test will not be made if IP ( 2 ) <= 0. Output .. All TYPE REAL variables are DOUBLE PRECISION X ( * ), RNORME , The array X ( * ) contains the solution parameters RNORML if the integer output flag MODE = 0 or 1. The definition of MODE is given directly below . When MODE = 0 or 1 , RNORME and RNORML respectively contain the residual vector Euclidean lengths of F - EX and B - AX . When MODE = 1 the equality constraint equations EX = F are contradictory , so RNORME /= 0. The residual vector F - EX has minimal Euclidean length . For MODE >= 2 , none of these parameters is defined . MODE Integer flag that indicates the subprogram status after completion . If MODE >= 2 , no solution has been computed . MODE = 0 Both equality and inequality constraints are compatible and have been satisfied . 1 Equality constraints are contradictory . A generalized inverse solution of EX = F was used to minimize the residual vector length F - EX . In this sense , the solution is still meaningful . 2 Inequality constraints are contradictory . 3 Both equality and inequality constraints are contradictory . The following interpretation of MODE = 1 , 2 or 3 must be made . The sets consisting of all solutions of the equality constraints EX = F and all vectors satisfying GX >= H have no points in common . ( In particular this does not say that each individual set has no points at all , although this could be the case .) 4 Usage error occurred . The value of MDW is < ME + MA + MG , MDW is < N and a covariance matrix is requested , or the option vector PRGOPT ( * ) is not properly defined , or the lengths of the working arrays WS ( * ) and IP ( * ), when specified in IP ( 1 ) and IP ( 2 ) respectively , are not long enough . W ( * , * ) The array W ( * , * ) contains the N by N symmetric covariance matrix of the solution parameters , provided this was requested on input with the option vector PRGOPT ( * ) and the output flag is returned with MODE = 0 or 1. IP ( * ) The integer working array has three entries that provide rank and working array length information after completion . IP ( 1 ) = rank of equality constraint matrix . Define this quantity as KRANKE . IP ( 2 ) = rank of reduced least squares problem . IP ( 3 ) = the amount of storage in the working array WS ( * ) that was actually used by the subprogram . The formula given above for the length of WS ( * ) is a necessary overestimate . If exactly the same problem matrices are used in subsequent executions , the declared dimension of WS ( * ) can be reduced to this output value . User Designated Working Arrays .. WS ( * ), IP ( * ) These are respectively type real and type integer working arrays . Their required minimal lengths are given above . References K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Report SAND77-0552, Sandia\n Laboratories, June 1978. K. H. Haskell and R. J. Hanson, Selected algorithms for\n the linearly constrained least squares problem - a\n users guide, Report SAND78-1290, Sandia Laboratories,\n August 1979. K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Mathematical Programming\n 21 (1981), pp. 98-118. R. J. Hanson and K. H. Haskell, Two algorithms for the\n linearly constrained least squares problem, ACM\n Transactions on Mathematical Software, September 1982. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 890831 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900510 Convert XERRWV calls to XERMSG calls. (RWC) 900604 DP version created from SP version. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer, intent(in) :: mdw integer :: me integer :: ma integer :: mg integer :: n real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorme real(kind=wp) :: rnorml integer :: mode real(kind=wp) :: ws (*) integer :: ip (3) Calls proc~~dlsei~~CallsGraph proc~dlsei bspline_defc_module::dlsei proc~dasum bspline_blas_module::dasum proc~dlsei->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dlsei->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dlsei->proc~dcopy proc~ddot bspline_blas_module::ddot proc~dlsei->proc~ddot proc~dh12 bspline_defc_module::dh12 proc~dlsei->proc~dh12 proc~dlsi bspline_defc_module::dlsi proc~dlsei->proc~dlsi proc~dnrm2 bspline_blas_module::dnrm2 proc~dlsei->proc~dnrm2 proc~dscal bspline_blas_module::dscal proc~dlsei->proc~dscal proc~dswap bspline_blas_module::dswap proc~dlsei->proc~dswap proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dlsi->proc~dasum proc~dlsi->proc~daxpy proc~dlsi->proc~dcopy proc~dlsi->proc~ddot proc~dlsi->proc~dh12 proc~dlsi->proc~dscal proc~dlsi->proc~dswap proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~ddot proc~dlpdp->proc~dnrm2 proc~dlpdp->proc~dscal proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~dasum proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dnrm2 proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dswap proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dlsei~~CalledByGraph proc~dlsei bspline_defc_module::dlsei proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dlsei ( w , mdw , me , ma , mg , n , prgopt , x , rnorme , & rnorml , mode , ws , ip ) integer , intent ( in ) :: mdw real ( wp ) :: w ( mdw , * ) integer :: me integer :: ma integer :: mg integer :: n real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) real ( wp ) :: rnorme real ( wp ) :: rnorml integer :: mode real ( wp ) :: ws ( * ) integer :: ip ( 3 ) real ( wp ) :: enorm , fnorm , gam , rb , rn , rnmax , size , & sn , snmax , t , tau , uj , up , vj , xnorm , xnrme integer :: i , imax , j , jp1 , k , key , kranke , last , lchk , link , m , & mapke1 , mdeqc , mend , mep1 , n1 , n2 , next , nlink , nopt , np1 , & ntimes logical :: cov , done character ( len = 8 ) :: xern1 , xern2 , xern3 , xern4 ! Set the nominal tolerance used in the code for the equality ! constraint equations. tau = sqrt ( drelpr ) ! Check that enough storage was allocated in WS(*) and IP(*). mode = 4 if ( min ( n , me , ma , mg ) < 0 ) then write ( xern1 , '(I8)' ) n write ( xern2 , '(I8)' ) me write ( xern3 , '(I8)' ) ma write ( xern4 , '(I8)' ) mg write ( * , * ) 'ALL OF THE VARIABLES N, ME,' // & ' MA, MG MUST BE >= 0. ENTERED ROUTINE WITH: ' // & 'N = ' // trim ( adjustl ( xern1 )) // & ', ME = ' // trim ( adjustl ( xern2 )) // & ', MA = ' // trim ( adjustl ( xern3 )) // & ', MG = ' // trim ( adjustl ( xern4 )) return endif if ( ip ( 1 ) > 0 ) then lchk = 2 * ( me + n ) + max ( ma + mg , n ) + ( mg + 2 ) * ( n + 7 ) if ( ip ( 1 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WS(*), NEED LW = ' // xern1 return endif endif if ( ip ( 2 ) > 0 ) then lchk = mg + 2 * n + 2 if ( ip ( 2 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IP(*), NEED LIP = ' // xern1 return endif endif ! Compute number of possible right multiplying Householder ! transformations. m = me + ma + mg if ( n <= 0 . or . m <= 0 ) then mode = 0 rnorme = 0 rnorml = 0 return endif if ( mdw < m ) then write ( * , * ) 'MDW < ME+MA+MG IS AN ERROR' return endif np1 = n + 1 kranke = min ( me , n ) n1 = 2 * kranke + 1 n2 = n1 + n ! Set nominal values. ! ! The nominal column scaling used in the code is ! the identity scaling. call dcopy ( n , [ 1.0_wp ], 0 , ws ( n1 ), 1 ) ! No covariance matrix is nominally computed. cov = . false . ! Process option vector. ! Define bound for number of options to change. nopt = 1000 ntimes = 0 ! Define bound for positive values of LINK. nlink = 100000 last = 1 link = prgopt ( 1 ) if ( link == 0 . or . link > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 1 ) then cov = prgopt ( last + 2 ) /= 0.0_wp elseif ( key == 2 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t ws ( j + n1 - 1 ) = t end do elseif ( key == 3 ) then call dcopy ( n , prgopt ( last + 2 ), 1 , ws ( n1 ), 1 ) elseif ( key == 4 ) then tau = max ( drelpr , prgopt ( last + 2 )) endif next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , ws ( n1 + j - 1 ), w ( 1 , j ), 1 ) end do if ( cov . and . mdw < n ) then write ( * , * ) 'MDW < N WHEN COV MATRIX NEEDED, IS AN ERROR' return endif ! Problem definition and option vector OK. mode = 0 ! Compute norm of equality constraint matrix and right side. enorm = 0.0_wp do j = 1 , n enorm = max ( enorm , dasum ( me , w ( 1 , j ), 1 )) end do fnorm = dasum ( me , w ( 1 , np1 ), 1 ) snmax = 0.0_wp rnmax = 0.0_wp do i = 1 , kranke ! Compute maximum ratio of vector lengths. Partition is at ! column I. do k = i , me sn = ddot ( n - i + 1 , w ( k , i ), mdw , w ( k , i ), mdw ) rn = ddot ( i - 1 , w ( k , 1 ), mdw , w ( k , 1 ), mdw ) if ( rn == 0.0_wp . and . sn > snmax ) then snmax = sn imax = k elseif ( k == i . or . sn * rnmax > rn * snmax ) then snmax = sn rnmax = rn imax = k endif end do ! Interchange rows if necessary. if ( i /= imax ) call dswap ( np1 , w ( i , 1 ), mdw , w ( imax , 1 ), mdw ) if ( snmax > rnmax * tau ** 2 ) then ! Eliminate elements I+1,...,N in row I. call dh12 ( 1 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), w ( i + 1 , 1 ), mdw , 1 , m - i ) else kranke = i - 1 exit endif end do ! Save diagonal terms of lower trapezoidal matrix. call dcopy ( kranke , w , mdw + 1 , ws ( kranke + 1 ), 1 ) ! Use Householder transformation from left to achieve ! KRANKE by KRANKE upper triangular form. if ( kranke < me ) then do k = kranke , 1 , - 1 ! Apply transformation to matrix cols. 1,...,K-1. call dh12 ( 1 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w , 1 , mdw , k - 1 ) ! Apply to rt side vector. call dh12 ( 2 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w ( 1 , np1 ), 1 , 1 , 1 ) end do endif ! Solve for variables 1,...,KRANKE in new coordinates. call dcopy ( kranke , w ( 1 , np1 ), 1 , x , 1 ) do i = 1 , kranke x ( i ) = ( x ( i ) - ddot ( i - 1 , w ( i , 1 ), mdw , x , 1 )) / w ( i , i ) end do ! Compute residuals for reduced problem. mep1 = me + 1 rnorml = 0.0_wp do i = mep1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( kranke , w ( i , 1 ), mdw , x , 1 ) sn = ddot ( kranke , w ( i , 1 ), mdw , w ( i , 1 ), mdw ) rn = ddot ( n - kranke , w ( i , kranke + 1 ), mdw , w ( i , kranke + 1 ), mdw ) if ( rn <= sn * tau ** 2 . and . kranke < n ) & call dcopy ( n - kranke , [ 0.0_wp ], 0 , w ( i , kranke + 1 ), mdw ) end do ! Compute equality constraint equations residual length. rnorme = dnrm2 ( me - kranke , w ( kranke + 1 , np1 ), 1 ) ! Move reduced problem data upward if KRANKE 0 ) then mdeqc = 0 xnrme = dasum ( kranke , w ( 1 , np1 ), 1 ) if ( rnorme > tau * ( enorm * xnrme + fnorm )) mdeqc = 1 mode = mode + mdeqc ! Check if solution to equality constraints satisfies inequality ! constraints when there are no degrees of freedom left. if ( kranke == n . and . mg > 0 ) then xnorm = dasum ( n , x , 1 ) mapke1 = ma + kranke + 1 mend = ma + kranke + mg do i = mapke1 , mend size = dasum ( n , w ( i , 1 ), mdw ) * xnorm + abs ( w ( i , np1 )) if ( w ( i , np1 ) > tau * size ) then mode = mode + 2 done = . true . exit endif end do endif endif if (. not . done ) then ! Replace diagonal terms of lower trapezoidal matrix. if ( kranke > 0 ) then call dcopy ( kranke , ws ( kranke + 1 ), 1 , w , mdw + 1 ) ! Reapply transformation to put solution in original coordinates. do i = kranke , 1 , - 1 call dh12 ( 2 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), x , 1 , 1 , 1 ) end do ! Compute covariance matrix of equality constrained problem. if ( cov ) then do j = min ( kranke , n - 1 ), 1 , - 1 rb = ws ( j ) * w ( j , j ) if ( rb /= 0.0_wp ) rb = 1.0_wp / rb jp1 = j + 1 do i = jp1 , n w ( i , j ) = rb * ddot ( n - j , w ( i , jp1 ), mdw , w ( j , jp1 ), mdw ) end do gam = 0.5_wp * rb * ddot ( n - j , w ( jp1 , j ), 1 , w ( j , jp1 ), mdw ) call daxpy ( n - j , gam , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) do i = jp1 , n do k = i , n w ( i , k ) = w ( i , k ) + w ( j , i ) * w ( k , j ) + w ( i , j ) * w ( j , k ) w ( k , i ) = w ( i , k ) end do end do uj = ws ( j ) vj = gam * uj w ( j , j ) = uj * vj + uj * vj do i = jp1 , n w ( j , i ) = uj * w ( i , j ) + vj * w ( j , i ) end do call dcopy ( n - j , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) end do endif endif ! Apply the scaling to the covariance matrix. if ( cov ) then do i = 1 , n call dscal ( n , ws ( i + n1 - 1 ), w ( i , 1 ), mdw ) call dscal ( n , ws ( i + n1 - 1 ), w ( 1 , i ), 1 ) end do endif end if ! Rescale solution vector. if ( mode <= 1 ) then do j = 1 , n x ( j ) = x ( j ) * ws ( n1 + j - 1 ) end do endif ip ( 1 ) = kranke ip ( 3 ) = ip ( 3 ) + 2 * kranke + n end subroutine dlsei","tags":"","loc":"proc/dlsei.html"},{"title":"dlsi – bspline-fortran","text":"private subroutine dlsi(w, mdw, ma, mg, n, prgopt, x, rnorm, mode, ws, ip) This is a companion subprogram to DLSEI . The documentation for DLSEI has complete usage instructions. Solve: AX = B, A MA by N (least squares equations) subject to: GX >= H , G MG by N ( inequality constraints ) Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and extensively revised (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 900604 DP version created from SP version. (RWC) 920422 Changed CALL to DHFTI to include variable MA. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) W(*,*) contains: (A B)\n (G H) in rows 1,...,MA+MG ,\n cols 1,...,N+1 . integer, intent(in) :: mdw contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: ma contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: mg contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: n contain (resp) var. dimension of W(*,*) , and matrix dimensions. real(kind=wp), intent(in) :: prgopt (*) Program option vector. real(kind=wp), intent(out) :: x (*) Solution vector(unless MODE=2) real(kind=wp), intent(out) :: rnorm length of AX-B. integer, intent(out) :: mode =0 Inequality constraints are compatible. =2 Inequality constraints contradictory. real(kind=wp) :: ws (*) Working storage of dimension K+N+(MG+2)*(N+7) ,\nwhere K=MAX(MA+MG,N) . integer :: ip (*) IP(MG+2*N+1) Integer working storage Calls proc~~dlsi~~CallsGraph proc~dlsi bspline_defc_module::dlsi proc~dasum bspline_blas_module::dasum proc~dlsi->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dlsi->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dlsi->proc~dcopy proc~ddot bspline_blas_module::ddot proc~dlsi->proc~ddot proc~dh12 bspline_defc_module::dh12 proc~dlsi->proc~dh12 proc~dhfti bspline_defc_module::dhfti proc~dlsi->proc~dhfti proc~dlpdp bspline_defc_module::dlpdp proc~dlsi->proc~dlpdp proc~dscal bspline_blas_module::dscal proc~dlsi->proc~dscal proc~dswap bspline_blas_module::dswap proc~dlsi->proc~dswap proc~dh12->proc~daxpy proc~dh12->proc~ddot proc~dh12->proc~dswap proc~dhfti->proc~dh12 proc~dlpdp->proc~dcopy proc~dlpdp->proc~ddot proc~dlpdp->proc~dscal proc~dnrm2 bspline_blas_module::dnrm2 proc~dlpdp->proc~dnrm2 proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp->proc~dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dwnlsm->proc~dasum proc~dwnlsm->proc~daxpy proc~dwnlsm->proc~dcopy proc~dwnlsm->proc~dh12 proc~dwnlsm->proc~dscal proc~dwnlsm->proc~dswap proc~dwnlsm->proc~dnrm2 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dlsi~~CalledByGraph proc~dlsi bspline_defc_module::dlsi proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dlsi ( w , mdw , ma , mg , n , prgopt , x , rnorm , mode , ws , ip ) integer , intent ( in ) :: mdw !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: ma !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: mg !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: n !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. real ( wp ) :: w ( mdw , * ) !! `W(*,*)` contains: !! !!``` !! (A B) !! (G H) !!``` !! !! in rows `1,...,MA+MG`, !! cols `1,...,N+1`. real ( wp ), intent ( in ) :: prgopt ( * ) !! Program option vector. real ( wp ), intent ( out ) :: x ( * ) !! Solution vector(unless MODE=2) real ( wp ), intent ( out ) :: rnorm !! length of AX-B. integer , intent ( out ) :: mode !! * `=0` Inequality constraints are compatible. !! * `=2` Inequality constraints contradictory. real ( wp ) :: ws ( * ) !! Working storage of dimension `K+N+(MG+2)*(N+7)`, !! where `K=MAX(MA+MG,N)`. integer :: ip ( * ) !! `IP(MG+2*N+1)` Integer working storage real ( wp ) :: anorm , fac , gam , rb , tau , tol , xnorm integer :: i , j , k , key , krank , krm1 , krp1 , l , last , link , m , map1 , & mdlpdp , minman , n1 , n2 , n3 , next , np1 logical :: cov , sclcov real ( wp ) :: rnorm_ ( 1 ) !! JW added for call to [[dhfti]] ! Set the nominal tolerance used in the code. tol = sqrt ( drelpr ) mode = 0 rnorm = 0.0_wp m = ma + mg np1 = n + 1 krank = 0 main : block if ( n <= 0 . or . m <= 0 ) exit main ! To process option vector. cov = . false . sclcov = . true . last = 1 link = prgopt ( 1 ) do if ( link <= 1 ) exit key = prgopt ( last + 1 ) if ( key == 1 ) cov = prgopt ( last + 2 ) /= 0.0_wp if ( key == 10 ) sclcov = prgopt ( last + 2 ) == 0.0_wp if ( key == 5 ) tol = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) last = link link = next end do ! Compute matrix norm of least squares equations. anorm = 0.0_wp do j = 1 , n anorm = max ( anorm , dasum ( ma , w ( 1 , j ), 1 )) end do ! Set tolerance for DHFTI( ) rank test. tau = tol * anorm ! Compute Householder orthogonal decomposition of matrix. call dcopy ( n , [ 0.0_wp ], 0 , ws , 1 ) call dcopy ( ma , w ( 1 , np1 ), 1 , ws , 1 ) k = max ( m , n ) minman = min ( ma , n ) n1 = k + 1 n2 = n1 + n rnorm_ ( 1 ) = rnorm ! JW call dhfti ( w , mdw , ma , n , ws , ma , 1 , tau , krank , rnorm_ , ws ( n2 ), & ws ( n1 ), ip ) rnorm = rnorm_ ( 1 ) ! JW fac = 1.0_wp gam = ma - krank if ( krank < ma . and . sclcov ) fac = rnorm ** 2 / gam ! Reduce to DLPDP and solve. map1 = ma + 1 ! Compute inequality rt-hand side for DLPDP. if ( ma < m ) then if ( minman > 0 ) then do i = map1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( n , w ( i , 1 ), mdw , ws , 1 ) end do ! Apply permutations to col. of inequality constraint matrix. do i = 1 , minman call dswap ( mg , w ( map1 , i ), 1 , w ( map1 , ip ( i )), 1 ) end do ! Apply Householder transformations to constraint matrix. if ( krank > 0 . and . krank < n ) then do i = krank , 1 , - 1 call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & w ( map1 , 1 ), mdw , 1 , mg ) end do endif ! Compute permuted inequality constraint matrix times r-inv. do i = map1 , m do j = 1 , krank w ( i , j ) = ( w ( i , j ) - ddot ( j - 1 , w ( 1 , j ), 1 , w ( i , 1 ), mdw )) / w ( j , j ) end do end do endif ! Solve the reduced problem with DLPDP algorithm, ! the least projected distance problem. call dlpdp ( w ( map1 , 1 ), mdw , mg , krank , n - krank , prgopt , x , & xnorm , mdlpdp , ws ( n2 ), ip ( n + 1 )) ! Compute solution in original coordinates. if ( mdlpdp == 1 ) then do i = krank , 1 , - 1 x ( i ) = ( x ( i ) - ddot ( krank - i , w ( i , i + 1 ), mdw , x ( i + 1 ), 1 )) / w ( i , i ) end do ! Apply Householder transformation to solution vector. if ( krank < n ) then do i = 1 , krank call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & x , 1 , 1 , 1 ) end do endif ! Repermute variables to their input order. if ( minman > 0 ) then do i = minman , 1 , - 1 call dswap ( 1 , x ( i ), 1 , x ( ip ( i )), 1 ) end do ! Variables are now in original coordinates. ! Add solution of unconstrained problem. do i = 1 , n x ( i ) = x ( i ) + ws ( i ) end do ! Compute the residual vector norm. rnorm = sqrt ( rnorm ** 2 + xnorm ** 2 ) endif else mode = 2 endif else call dcopy ( n , ws , 1 , x , 1 ) endif ! Compute covariance matrix based on the orthogonal decomposition ! from DHFTI( ). if (. not . cov . or . krank <= 0 ) exit main krm1 = krank - 1 krp1 = krank + 1 ! Copy diagonal terms to working array. call dcopy ( krank , w , mdw + 1 , ws ( n2 ), 1 ) ! Reciprocate diagonal terms. do j = 1 , krank w ( j , j ) = 1.0_wp / w ( j , j ) end do ! Invert the upper triangular QR factor on itself. if ( krank > 1 ) then do i = 1 , krm1 do j = i + 1 , krank w ( i , j ) = - ddot ( j - i , w ( i , i ), mdw , w ( i , j ), 1 ) * w ( j , j ) end do end do endif ! Compute the inverted factor times its transpose. do i = 1 , krank do j = i , krank w ( i , j ) = ddot ( krank + 1 - j , w ( i , j ), mdw , w ( j , j ), mdw ) end do end do ! Zero out lower trapezoidal part. ! Copy upper triangular to lower triangular part. if ( krank < n ) then do j = 1 , krank call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do do i = krp1 , n call dcopy ( i , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Apply right side transformations to lower triangle. n3 = n2 + krp1 do i = 1 , krank l = n1 + i k = n2 + i rb = ws ( l - 1 ) * ws ( k - 1 ) ! If RB>=0.0_wp, transformation can be regarded as zero. if ( rb < 0.0_wp ) then rb = 1.0_wp / rb ! Store unscaled rank one Householder update in work array. call dcopy ( n , [ 0.0_wp ], 0 , ws ( n3 ), 1 ) l = n1 + i k = n3 + i ws ( k - 1 ) = ws ( l - 1 ) do j = krp1 , n ws ( n3 + j - 1 ) = w ( i , j ) end do do j = 1 , n ws ( j ) = rb * ( ddot ( j - i , w ( j , i ), mdw , ws ( n3 + i - 1 ), 1 ) + & ddot ( n - j + 1 , w ( j , j ), 1 , ws ( n3 + j - 1 ), 1 )) end do l = n3 + i gam = 0.5_wp * rb * ddot ( n - i + 1 , ws ( l - 1 ), 1 , ws ( i ), 1 ) call daxpy ( n - i + 1 , gam , ws ( l - 1 ), 1 , ws ( i ), 1 ) do j = i , n do l = 1 , i - 1 w ( j , l ) = w ( j , l ) + ws ( n3 + j - 1 ) * ws ( l ) end do do l = i , j w ( j , l ) = w ( j , l ) + ws ( j ) * ws ( n3 + l - 1 ) + ws ( l ) * ws ( n3 + j - 1 ) end do end do endif end do ! Copy lower triangle to upper triangle to symmetrize the ! covariance matrix. do i = 1 , n call dcopy ( i , w ( i , 1 ), mdw , w ( 1 , i ), 1 ) end do endif ! Repermute rows and columns. do i = minman , 1 , - 1 k = ip ( i ) if ( i /= k ) then call dswap ( 1 , w ( i , i ), 1 , w ( k , k ), 1 ) call dswap ( i - 1 , w ( 1 , i ), 1 , w ( 1 , k ), 1 ) call dswap ( k - i - 1 , w ( i , i + 1 ), mdw , w ( i + 1 , k ), 1 ) call dswap ( n - k , w ( i , k + 1 ), mdw , w ( k , k + 1 ), mdw ) endif end do ! Put in normalized residual sum of squares scale factor ! and symmetrize the resulting covariance matrix. do j = 1 , n call dscal ( j , fac , w ( 1 , j ), 1 ) call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do end block main ip ( 1 ) = krank ip ( 2 ) = n + max ( m , n ) + ( mg + 2 ) * ( n + 7 ) end subroutine dlsi","tags":"","loc":"proc/dlsi.html"},{"title":"dwnlit – bspline-fortran","text":"private subroutine dwnlit(w, mdw, m, n, l, ipivot, itype, h, scale, rnorm, idope, dope, done) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. Note: The M by (N+1) matrix W( , ) contains the rt. hand side B as the (N+1) st col. Triangularize L1 by L1 subsystem, where L1=MIN(M,L) , with\n col interchanges. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and revised. (WRB & RWC) 890620 Revised to make WNLT1, WNLT2, and WNLT3 subroutines. (RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900328 Added TYPE section. (WRB) 900604 DP version created from SP version. . (RWC) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: m integer :: n integer :: l integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: rnorm integer :: idope (*) real(kind=wp) :: dope (*) logical :: done Calls proc~~dwnlit~~CallsGraph proc~dwnlit bspline_defc_module::dwnlit proc~dcopy bspline_blas_module::dcopy proc~dwnlit->proc~dcopy proc~dh12 bspline_defc_module::dh12 proc~dwnlit->proc~dh12 proc~drotm bspline_blas_module::drotm proc~dwnlit->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlit->proc~drotmg proc~dscal bspline_blas_module::dscal proc~dwnlit->proc~dscal proc~dswap bspline_blas_module::dswap proc~dwnlit->proc~dswap proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~idamax bspline_blas_module::idamax proc~dwnlit->proc~idamax proc~dh12->proc~dswap proc~daxpy bspline_blas_module::daxpy proc~dh12->proc~daxpy proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlit~~CalledByGraph proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , & rnorm , idope , dope , done ) integer :: idope ( * ), ipivot ( * ), itype ( * ), l , m , mdw , n real ( wp ) :: dope ( * ), h ( * ), rnorm , scale ( * ), w ( mdw , * ) logical :: done real ( wp ) :: alsq , amax , eanorm , factor , hbar , rn , sparam ( 5 ), & t , tau integer :: i , i1 , imax , ir , j , j1 , jj , jp , krank , l1 , lb , lend , me , & mend , niv , nsoln logical :: indep , recalc me = idope ( 1 ) nsoln = idope ( 2 ) l1 = idope ( 3 ) alsq = dope ( 1 ) eanorm = dope ( 2 ) tau = dope ( 3 ) lb = min ( m - 1 , l ) recalc = . true . rnorm = 0.0_wp krank = 0 ! We set FACTOR=1.0 so that the heavy weight ALAMDA will be ! included in the test for column independence. factor = 1.0_wp lend = l main : block do i = 1 , lb ! Set IR to point to the I-th row. ir = i mend = m call dwnlt1 ( i , lend , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) do ! Perform column interchange. ! Test independence of incoming column. if ( dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then ! Eliminate I-th column below diagonal using modified Givens ! transformations applied to (A B). ! ! When operating near the ME line, use the largest element ! above it as the pivot. do j = m , i + 1 , - 1 jp = j - 1 if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , i ) ** 2 do jp = j - 1 , i , - 1 t = scale ( jp ) * w ( jp , i ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( jp , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do exit else if ( lend > i ) then ! Column I is dependent. Swap with column LEND. ! Perform column interchange, ! and find column in remaining set with largest SS. call dwnlt3 ( i , lend , m , mdw , ipivot , h , w ) lend = lend - 1 imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) else krank = i - 1 exit main endif end do end do krank = l1 end block main if ( krank < me ) then factor = alsq do i = krank + 1 , me call dcopy ( l , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Determine the rank of the remaining equality constraint ! equations by eliminating within the block of constrained ! variables. Remove any redundant constraints. recalc = . true . lb = min ( l + me - krank , n ) do i = l + 1 , lb ir = krank + i - l lend = n mend = me call dwnlt1 ( i , lend , me , ir , mdw , recalc , imax , hbar , h , & scale , w ) ! Update col ss and find pivot col call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange ! Eliminate elements in the I-th col. do j = me , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do ! I=column being eliminated. ! Test independence of incoming column. ! Remove any redundant or dependent equality constraints. if (. not . dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then jj = ir do ir = jj , me call dcopy ( n , [ 0.0_wp ], 0 , w ( ir , 1 ), mdw ) rnorm = rnorm + ( scale ( ir ) * w ( ir , n + 1 ) / alsq ) * w ( ir , n + 1 ) w ( ir , n + 1 ) = 0.0_wp scale ( ir ) = 1.0_wp ! Reclassify the zeroed row as a least squares equation. itype ( ir ) = 1 end do ! Reduce ME to reflect any discovered dependent equality ! constraints. me = jj - 1 exit endif end do endif ! Try to determine the variables KRANK+1 through L1 from the ! least squares equations. Continue the triangularization with ! pivot element W(ME+1,I). if ( krank < l1 ) then recalc = . true . ! Set FACTOR=ALSQ to remove effect of heavy weight from ! test for column independence. factor = alsq do i = krank + 1 , l1 ! Set IR to point to the ME+1-st row. ir = me + 1 lend = l mend = m call dwnlt1 ( i , l , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange. ! Eliminate I-th column below the IR-th element. do j = m , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , sparam ) endif end do ! Test if new pivot element is near zero. ! If so, the column is dependent. ! Then check row norm test to be classified as independent. t = scale ( ir ) * w ( ir , i ) ** 2 indep = t > ( tau * eanorm ) ** 2 if ( indep ) then rn = 0.0_wp do i1 = ir , m do j1 = i + 1 , n rn = max ( rn , scale ( i1 ) * w ( i1 , j1 ) ** 2 ) end do end do indep = t > rn * tau ** 2 endif ! If independent, swap the IR-th and KRANK+1-th rows to ! maintain the triangular form. Update the rank indicator ! KRANK and the equality constraint pointer ME. if (. not . indep ) exit call dswap ( n + 1 , w ( krank + 1 , 1 ), mdw , w ( ir , 1 ), mdw ) call dswap ( 1 , scale ( krank + 1 ), 1 , scale ( ir ), 1 ) ! Reclassify the least square equation as an equality ! constraint and rescale it. itype ( ir ) = 0 t = sqrt ( scale ( krank + 1 )) call dscal ( n + 1 , t , w ( krank + 1 , 1 ), mdw ) scale ( krank + 1 ) = alsq me = me + 1 krank = krank + 1 end do endif ! If pseudorank is less than L, apply Householder transformation. ! from right. if ( krank < l ) then do j = krank , 1 , - 1 call dh12 ( 1 , j , krank + 1 , l , w ( j , 1 ), mdw , h ( j ), w , mdw , 1 , & j - 1 ) end do endif niv = krank + nsoln - l if ( l == n ) done = . true . ! End of initial triangularization. idope ( 1 ) = me idope ( 2 ) = krank idope ( 3 ) = niv end subroutine dwnlit","tags":"","loc":"proc/dwnlit.html"},{"title":"dwnlsm – bspline-fortran","text":"private subroutine dwnlsm(w, mdw, mme, ma, n, l, prgopt, x, rnorm, mode, ipivot, itype, wd, h, scale, z, temp, d) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. In addition to the parameters discussed in the prologue to\n subroutine DWNNLS , the following work arrays are used in\n subroutine DWNLSM (they are passed through the calling\n sequence from DWNNLS for purposes of variable dimensioning).\n Their contents will in general be of no interest to the user. IPIVOT ( * ) An array of length N . Upon completion it contains the pivoting information for the cols of W ( * , * ) . ITYPE ( * ) An array of length M which is used to keep track of the classification of the equations . ITYPE ( I ) = 0 denotes equation I as an equality constraint . ITYPE ( I ) = 1 denotes equation I as a least squares equation . WD ( * ) An array of length N . Upon completion it contains the dual solution vector . H ( * ) An array of length N . Upon completion it contains the pivot scalars of the Householder transformations performed in the case KRANK < L . SCALE ( * ) An array of length M which is used by the subroutine to store the diagonal matrix of weights . These are used to apply the modified Givens transformations . Z ( * ), TEMP ( * ) Working arrays of length N . D ( * ) An array of length N that contains the column scaling for the matrix ( E ) . ( A ) Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and revised. (WRB & RWC) 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900328 Added TYPE section. (WRB) 900510 Fixed an error message. (RWC) 900604 DP version created from SP version. (RWC) 900911 Restriction on value of ALAMDA included. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: mme integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: wd (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: z (*) real(kind=wp) :: temp (*) real(kind=wp) :: d (*) Calls proc~~dwnlsm~~CallsGraph proc~dwnlsm bspline_defc_module::dwnlsm proc~dasum bspline_blas_module::dasum proc~dwnlsm->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dwnlsm->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dwnlsm->proc~dcopy proc~dh12 bspline_defc_module::dh12 proc~dwnlsm->proc~dh12 proc~dnrm2 bspline_blas_module::dnrm2 proc~dwnlsm->proc~dnrm2 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dscal bspline_blas_module::dscal proc~dwnlsm->proc~dscal proc~dswap bspline_blas_module::dswap proc~dwnlsm->proc~dswap proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dh12->proc~daxpy proc~dh12->proc~dswap proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlsm~~CalledByGraph proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlsm ( w , mdw , mme , ma , n , l , prgopt , x , rnorm , mode , & ipivot , itype , wd , h , scale , z , temp , d ) integer :: ipivot ( * ), itype ( * ), l , ma , mdw , mme , mode , n real ( wp ) :: d ( * ), h ( * ), prgopt ( * ), rnorm , scale ( * ), temp ( * ), & w ( mdw , * ), wd ( * ), x ( * ), z ( * ) real ( wp ) :: alamda , alpha , alsq , amax , blowup , bnorm , & dope ( 3 ), eanorm , fac , sm , sparam ( 5 ), t , tau , wmax , z2 , & zz integer :: i , idope ( 3 ), imax , isol , itemp , iter , itmax , iwmax , j , & jcon , jp , key , krank , l1 , last , link , m , me , next , niv , nlink , & nopt , nsoln , ntimes logical :: done , feasbl , hitcon , pos ! Set the nominal tolerance used in the code. tau = sqrt ( drelpr ) m = ma + mme me = mme mode = 2 ! To process option vector fac = 1.0e-4_wp ! Set the nominal blow up factor used in the code. blowup = tau ! The nominal column scaling used in the code is ! the identity scaling. call dcopy ( n , [ 1.0_wp ], 0 , d , 1 ) ! Define bound for number of options to change. nopt = 1000 ! Define bound for positive value of LINK. nlink = 100000 ntimes = 0 last = 1 link = prgopt ( 1 ) if ( link <= 0 . or . link > nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'IN DWNNLS, THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 6 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t d ( j ) = t end do endif if ( key == 7 ) call dcopy ( n , prgopt ( last + 2 ), 1 , d , 1 ) if ( key == 8 ) tau = max ( drelpr , prgopt ( last + 2 )) if ( key == 9 ) blowup = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , d ( j ), w ( 1 , j ), 1 ) end do ! Process option vector done = . false . iter = 0 itmax = 3 * ( n - l ) mode = 0 nsoln = l l1 = min ( m , l ) ! Compute scale factor to apply to equality constraint equations. do j = 1 , n wd ( j ) = dasum ( m , w ( 1 , j ), 1 ) end do imax = idamax ( n , wd , 1 ) eanorm = wd ( imax ) bnorm = dasum ( m , w ( 1 , n + 1 ), 1 ) alamda = eanorm / ( drelpr * fac ) ! On machines, such as the VAXes using D floating, with a very ! limited exponent range for double precision values, the previously ! computed value of ALAMDA may cause an overflow condition. ! Therefore, this code further limits the value of ALAMDA. alamda = min ( alamda , sqrt ( huge ( 1.0_wp ))) ! Define scaling diagonal matrix for modified Givens usage and ! classify equation types. alsq = alamda ** 2 do i = 1 , m ! When equation I is heavily weighted ITYPE(I)=0, ! else ITYPE(I)=1. if ( i <= me ) then t = alsq itemp = 0 else t = 1.0_wp itemp = 1 endif scale ( i ) = t itype ( i ) = itemp end do ! Set the solution vector X(*) to zero and the column interchange ! matrix to the identity. call dcopy ( n , [ 0.0_wp ], 0 , x , 1 ) do i = 1 , n ipivot ( i ) = i end do ! Perform initial triangularization in the submatrix ! corresponding to the unconstrained variables. ! Set first L components of dual vector to zero because ! these correspond to the unconstrained variables. call dcopy ( l , [ 0.0_wp ], 0 , wd , 1 ) ! The arrays IDOPE(*) and DOPE(*) are used to pass ! information to DWNLIT(). This was done to avoid ! a long calling sequence or the use of COMMON. idope ( 1 ) = me idope ( 2 ) = nsoln idope ( 3 ) = l1 dope ( 1 ) = alsq dope ( 2 ) = eanorm dope ( 3 ) = tau call dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , rnorm , & idope , dope , done ) me = idope ( 1 ) krank = idope ( 2 ) niv = idope ( 3 ) main : do ! Perform WNNLS algorithm using the following steps. ! ! Until(DONE) ! compute search direction and feasible point ! when (HITCON) add constraints ! else perform multiplier test and drop a constraint ! fin ! Compute-Final-Solution ! ! To compute search direction and feasible point, ! solve the triangular system of currently non-active ! variables and store the solution in Z(*). ! ! To solve system ! Copy right hand side into TEMP vector to use overwriting method. if ( done ) exit main isol = l + 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Increment iteration counter and check against maximum number ! of iterations. iter = iter + 1 if ( iter > itmax ) then mode = 1 done = . true . endif ! Check to see if any constraints have become active. ! If so, calculate an interpolation factor so that all ! active constraints are removed from the basis. alpha = 2.0_wp hitcon = . false . do j = l + 1 , nsoln zz = z ( j ) if ( zz <= 0.0_wp ) then t = x ( j ) / ( x ( j ) - zz ) if ( t < alpha ) then alpha = t jcon = j endif hitcon = . true . endif end do ! Compute search direction and feasible point if ( hitcon ) then ! To add constraints, use computed ALPHA to interpolate between ! last feasible solution X(*) and current unconstrained (and ! infeasible) solution Z(*). do j = l + 1 , nsoln x ( j ) = x ( j ) + alpha * ( z ( j ) - x ( j )) end do feasbl = . false . do ! Remove column JCON and shift columns JCON+1 through N to the ! left. Swap column JCON into the N th position. This achieves ! upper Hessenberg form for the nonactive constraints and ! leaves an upper Hessenberg matrix to retriangularize. do i = 1 , m t = w ( i , jcon ) call dcopy ( n - jcon , w ( i , jcon + 1 ), mdw , w ( i , jcon ), mdw ) w ( i , n ) = t end do ! Update permuted index vector to reflect this shift and swap. itemp = ipivot ( jcon ) do i = jcon , n - 1 ipivot ( i ) = ipivot ( i + 1 ) end do ipivot ( n ) = itemp ! Similarly permute X(*) vector. call dcopy ( n - jcon , x ( jcon + 1 ), 1 , x ( jcon ), 1 ) x ( n ) = 0.0_wp nsoln = nsoln - 1 niv = niv - 1 ! Retriangularize upper Hessenberg matrix after adding ! constraints. i = krank + jcon - l do j = jcon , nsoln if ( itype ( i ) == 0 . and . itype ( i + 1 ) == 0 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 1 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 0 ) then call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp ! Swapped row was formerly a pivot element, so it will ! be large enough to perform elimination. ! Zero IP1 to I in column J. if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 0 . and . itype ( i + 1 ) == 1 ) then if ( scale ( i ) * w ( i , j ) ** 2 / alsq > ( tau * eanorm ) ** 2 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), & w ( i + 1 , j ), sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp w ( i + 1 , j ) = 0.0_wp endif endif i = i + 1 end do ! See if the remaining coefficients in the solution set are ! feasible. They should be because of the way ALPHA was ! determined. If any are infeasible, it is due to roundoff ! error. Any that are non-positive will be set to zero and ! removed from the solution set. do jcon = l + 1 , nsoln if ( x ( jcon ) <= 0.0_wp ) then exit else if ( jcon == nsoln ) feasbl = . true . end if end do if ( feasbl ) exit end do else ! To perform multiplier test and drop a constraint. call dcopy ( nsoln , z , 1 , x , 1 ) if ( nsoln < n ) call dcopy ( n - nsoln , [ 0.0_wp ], 0 , x ( nsoln + 1 ), 1 ) ! Reclassify least squares equations as equalities as necessary. i = niv + 1 do if ( i > me ) exit if ( itype ( i ) == 0 ) then i = i + 1 else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( me , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( me ), 1 ) itemp = itype ( i ) itype ( i ) = itype ( me ) itype ( me ) = itemp me = me - 1 endif end do ! Form inner product vector WD(*) of dual coefficients. do j = nsoln + 1 , n sm = 0.0_wp do i = nsoln + 1 , m sm = sm + scale ( i ) * w ( i , j ) * w ( i , n + 1 ) end do wd ( j ) = sm end do do ! Find J such that WD(J)=WMAX is maximum. This determines ! that the incoming column J will reduce the residual vector ! and be positive. wmax = 0.0_wp iwmax = nsoln + 1 do j = nsoln + 1 , n if ( wd ( j ) > wmax ) then wmax = wd ( j ) iwmax = j endif end do if ( wmax <= 0.0_wp ) exit main ! Set dual coefficients to zero for incoming column. wd ( iwmax ) = 0.0_wp ! WMAX > 0.0_wp, so okay to move column IWMAX to solution set. ! Perform transformation to retriangularize, and test for near ! linear dependence. ! ! Swap column IWMAX into NSOLN-th position to maintain upper ! Hessenberg form of adjacent columns, and add new column to ! triangular decomposition. nsoln = nsoln + 1 niv = niv + 1 if ( nsoln /= iwmax ) then call dswap ( m , w ( 1 , nsoln ), 1 , w ( 1 , iwmax ), 1 ) wd ( iwmax ) = wd ( nsoln ) wd ( nsoln ) = 0.0_wp itemp = ipivot ( nsoln ) ipivot ( nsoln ) = ipivot ( iwmax ) ipivot ( iwmax ) = itemp endif ! Reduce column NSOLN so that the matrix of nonactive constraints ! variables is triangular. do j = m , niv + 1 , - 1 jp = j - 1 ! When operating near the ME line, test to see if the pivot ! element is near zero. If so, use the largest element above ! it as the pivot. This is to maintain the sharp interface ! between weighted and non-weighted rows in all cases. if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , nsoln ) ** 2 do jp = j - 1 , niv , - 1 t = scale ( jp ) * w ( jp , nsoln ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , nsoln ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , nsoln ), w ( j , nsoln ), sparam ) w ( j , nsoln ) = 0.0_wp call drotm ( n + 1 - nsoln , w ( jp , nsoln + 1 ), mdw , w ( j , nsoln + 1 ), mdw , sparam ) endif end do ! Solve for Z(NSOLN)=proposed new value for X(NSOLN). Test if ! this is nonpositive or too large. If this was true or if the ! pivot term was zero, reject the column as dependent. if ( w ( niv , nsoln ) /= 0.0_wp ) then isol = niv z2 = w ( isol , n + 1 ) / w ( isol , nsoln ) z ( nsoln ) = z2 pos = z2 > 0.0_wp if ( z2 * eanorm >= bnorm . and . pos ) then pos = . not . ( blowup * z2 * eanorm >= bnorm ) endif elseif ( niv <= me . and . w ( me + 1 , nsoln ) /= 0.0_wp ) then ! Try to add row ME+1 as an additional equality constraint. ! Check size of proposed new solution component. ! Reject it if it is too large. isol = me + 1 if ( pos ) then ! Swap rows ME+1 and NIV, and scale factors for these rows. call dswap ( n + 1 , w ( me + 1 , 1 ), mdw , w ( niv , 1 ), mdw ) call dswap ( 1 , scale ( me + 1 ), 1 , scale ( niv ), 1 ) itemp = itype ( me + 1 ) itype ( me + 1 ) = itype ( niv ) itype ( niv ) = itemp me = me + 1 endif else pos = . false . endif if (. not . pos ) then nsoln = nsoln - 1 niv = niv - 1 endif if ( pos . or . done ) exit end do endif end do main ! Else perform multiplier test and drop a constraint. To compute ! final solution. Solve system, store results in X(*). ! ! Copy right hand side into TEMP vector to use overwriting method. isol = 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Solve system. call dcopy ( nsoln , z , 1 , x , 1 ) ! Apply Householder transformations to X(*) if KRANKproc~idamax Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlt1~~CalledByGraph proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dwnlt1 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlt1 ( i , lend , mend , ir , mdw , recalc , imax , hbar , h , & scale , w ) integer :: i , imax , ir , lend , mdw , mend real ( wp ) :: h ( * ), hbar , scale ( * ), w ( mdw , * ) logical :: recalc integer :: j , k if ( ir /= 1 . and . (. not . recalc )) then ! Update column SS=sum of squares. do j = i , lend h ( j ) = h ( j ) - scale ( ir - 1 ) * w ( ir - 1 , j ) ** 2 end do ! Test for numerical accuracy. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 recalc = ( hbar + 1.e-3 * h ( imax )) == hbar endif ! If required, recalculate column SS, using rows IR through MEND. if ( recalc ) then do j = i , lend h ( j ) = 0.0_wp do k = ir , mend h ( j ) = h ( j ) + scale ( k ) * w ( k , j ) ** 2 end do end do ! Find column with largest SS. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) endif end subroutine dwnlt1","tags":"","loc":"proc/dwnlt1.html"},{"title":"dwnlt3 – bspline-fortran","text":"private subroutine dwnlt3(i, imax, m, mdw, ipivot, h, w) Perform column interchange.\n Exchange elements of permuted index vector and perform column\n interchanges. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890620 Code extracted from WNLIT and made a subroutine. (RWC)) 900604 DP version created from SP version. (RWC) Arguments Type Intent Optional Attributes Name integer, intent(in) :: i integer, intent(in) :: imax integer, intent(in) :: m integer, intent(in) :: mdw integer, intent(inout) :: ipivot (*) real(kind=wp), intent(inout) :: h (*) real(kind=wp), intent(inout) :: w (mdw,*) Calls proc~~dwnlt3~~CallsGraph proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dswap bspline_blas_module::dswap proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnlt3~~CalledByGraph proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit bspline_defc_module::dwnlit proc~dwnlit->proc~dwnlt3 proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnlsm->proc~dwnlit proc~dwnnls bspline_defc_module::dwnnls proc~dwnnls->proc~dwnlsm proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) integer , intent ( in ) :: i integer , intent ( in ) :: imax integer , intent ( inout ) :: ipivot ( * ) integer , intent ( in ) :: m integer , intent ( in ) :: mdw real ( wp ), intent ( inout ) :: h ( * ) real ( wp ), intent ( inout ) :: w ( mdw , * ) real ( wp ) :: t integer :: itemp if ( imax /= i ) then itemp = ipivot ( i ) ipivot ( i ) = ipivot ( imax ) ipivot ( imax ) = itemp call dswap ( m , w ( 1 , imax ), 1 , w ( 1 , i ), 1 ) t = h ( imax ) h ( imax ) = h ( i ) h ( i ) = t endif end subroutine dwnlt3","tags":"","loc":"proc/dwnlt3.html"},{"title":"dwnnls – bspline-fortran","text":"private subroutine dwnnls(w, mdw, me, ma, n, l, prgopt, x, rnorm, mode, iwork, work) This subprogram solves a linearly constrained least squares\n problem. Suppose there are given matrices E and A of\n respective dimensions ME by N and MA by N , and vectors F and B of respective lengths ME and MA . This subroutine\n solves the problem EX = F , (equations to be exactly satisfied) AX = B , (equations to be approximately satisfied, in the least squares sense) subject to components L+1,...,N nonnegative Any values ME>=0 , MA>=0 and 0<= L <=N are permitted. The problem is reposed as problem DWNNLS (WT*E)X = (WT*F)\n ( A) ( B), (least squares)\n subject to components L+1,...,N nonnegative. The subprogram chooses the heavy weight (or penalty parameter) WT . The parameters for DWNNLS are INPUT .. All TYPE REAL variables are DOUBLE PRECISION W ( * , * ), MDW , The array W ( * , * ) is double subscripted with first ME , MA , N , L dimensioning parameter equal to MDW . For this discussion let us call M = ME + MA . Then MDW must satisfy MDW >= M . The condition MDW < M is an error . The array W ( * , * ) contains the matrices and vectors ( E F ) ( A B ) in rows and columns 1 , ... , M and 1 , ... , N + 1 respectively . Columns 1 , ... , L correspond to unconstrained variables X ( 1 ), ... , X ( L ) . The remaining variables are constrained to be nonnegative . The condition L < 0 or L > N is an error . PRGOPT ( * ) This double precision array is the option vector . If the user is satisfied with the nominal subprogram features set PRGOPT ( 1 ) = 1 ( or PRGOPT ( 1 ) = 1.0 ) Otherwise PRGOPT ( * ) is a linked list consisting of groups of data of the following form LINK KEY DATA SET The parameters LINK and KEY are each one word . The DATA SET can be comprised of several words . The number of items depends on the value of KEY . The value of LINK points to the first entry of the next group of data within PRGOPT ( * ) . The exception is when there are no more options to change . In that case LINK = 1 and the values KEY and DATA SET are not referenced . The general layout of PRGOPT ( * ) is as follows . ... PRGOPT ( 1 ) = LINK1 ( link to first entry of next group ) . PRGOPT ( 2 ) = KEY1 ( key to the option change ) . PRGOPT ( 3 ) = DATA VALUE ( data value for this change ) . . . . . . ... PRGOPT ( LINK1 ) = LINK2 ( link to the first entry of . next group ) . PRGOPT ( LINK1 + 1 ) = KEY2 ( key to the option change ) . PRGOPT ( LINK1 + 2 ) = DATA VALUE ... . . . . . ... PRGOPT ( LINK ) = 1 ( no more options to change ) Values of LINK that are nonpositive are errors . A value of LINK > NLINK = 100000 is also an error . This helps prevent using invalid but positive values of LINK that will probably extend beyond the program limits of PRGOPT ( * ) . Unrecognized values of KEY are ignored . The order of the options is arbitrary and any number of options can be changed with the following restriction . To prevent cycling in the processing of the option array a count of the number of options changed is maintained . Whenever this count exceeds NOPT = 1000 an error message is printed and the subprogram returns . OPTIONS .. KEY = 6 Scale the nonzero columns of the entire data matrix ( E ) ( A ) to have length one . The DATA SET for this option is a single value . It must be nonzero if unit length column scaling is desired . KEY = 7 Scale columns of the entire data matrix ( E ) ( A ) with a user - provided diagonal matrix . The DATA SET for this option consists of the N diagonal scaling factors , one for each matrix column . KEY = 8 Change the rank determination tolerance from the nominal value of SQRT ( SRELPR ) . This quantity can be no smaller than SRELPR , The arithmetic - storage precision . The quantity used here is internally restricted to be at least SRELPR . The DATA SET for this option is the new tolerance . KEY = 9 Change the blow - up parameter from the nominal value of SQRT ( SRELPR ) . The reciprocal of this parameter is used in rejecting solution components as too large when a variable is first brought into the active set . Too large means that the proposed component times the reciprocal of the parameter is not less than the ratio of the norms of the right - side vector and the data matrix . This parameter can be no smaller than SRELPR , the arithmetic - storage precision . For example , suppose we want to provide a diagonal matrix to scale the problem matrix and change the tolerance used for determining linear dependence of dropped col vectors . For these options the dimensions of PRGOPT ( * ) must be at least N + 6. The FORTRAN statements defining these options would be as follows . PRGOPT ( 1 ) = N + 3 ( link to entry N + 3 in PRGOPT ( * )) PRGOPT ( 2 ) = 7 ( user - provided scaling key ) CALL DCOPY ( N , D , 1 , PRGOPT ( 3 ), 1 ) ( copy the N scaling factors from a user array called D ( * ) into PRGOPT ( 3 ) - PRGOPT ( N + 2 )) PRGOPT ( N + 3 ) = N + 6 ( link to entry N + 6 of PRGOPT ( * )) PRGOPT ( N + 4 ) = 8 ( linear dependence tolerance key ) PRGOPT ( N + 5 ) =... ( new value of the tolerance ) PRGOPT ( N + 6 ) = 1 ( no more options to change ) IWORK ( 1 ), The amounts of working storage actually allocated IWORK ( 2 ) for the working arrays WORK ( * ) and IWORK ( * ), respectively . These quantities are compared with the actual amounts of storage needed for DWNNLS ( ) . Insufficient storage allocated for either WORK ( * ) or IWORK ( * ) is considered an error . This feature was included in DWNNLS ( ) because miscalculating the storage formulas for WORK ( * ) and IWORK ( * ) might very well lead to subtle and hard - to - find execution errors . The length of WORK ( * ) must be at least LW = ME + MA + 5 * N This test will not be made if IWORK ( 1 ) <= 0. The length of IWORK ( * ) must be at least LIW = ME + MA + N This test will not be made if IWORK ( 2 ) <= 0. OUTPUT .. All TYPE REAL variables are DOUBLE PRECISION X ( * ) An array dimensioned at least N , which will contain the N components of the solution vector on output . RNORM The residual norm of the solution . The value of RNORM contains the residual vector length of the equality constraints and least squares equations . MODE The value of MODE indicates the success or failure of the subprogram . MODE = 0 Subprogram completed successfully . = 1 Max . number of iterations ( equal to 3 * ( N - L )) exceeded . Nearly all problems should complete in fewer than this number of iterations . An approximate solution and its corresponding residual vector length are in X ( * ) and RNORM . = 2 Usage error occurred . The offending condition is noted with the error processing subprogram , XERMSG ( ) . User - designated Working arrays .. WORK ( * ) A double precision working array of length at least M + 5 * N . IWORK ( * ) An integer - valued working array of length at least M + N . References K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Report SAND77-0552, Sandia\n Laboratories, June 1978. K. H. Haskell and R. J. Hanson, Selected algorithms for\n the linearly constrained least squares problem - a\n users guide, Report SAND78-1290, Sandia Laboratories,\n August 1979. K. H. Haskell and R. J. Hanson, An algorithm for\n linear least squares problems with equality and\n nonnegativity constraints, Mathematical Programming\n 21 (1981), pp. 98-118. R. J. Hanson and K. H. Haskell, Two algorithms for the\n linearly constrained least squares problem, ACM\n Transactions on Mathematical Software, September 1982. C. L. Lawson and R. J. Hanson, Solving Least Squares\n Problems, Prentice-Hall, Inc., 1974. Revision history 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) 890531 Changed all specific intrinsics to generic. (WRB) 890618 Completely restructured and revised. (WRB & RWC) 891006 REVISION DATE from Version 3.2 891214 Prologue converted to Version 4.0 format. (BAB) 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 900510 Convert XERRWV calls to XERMSG calls, change Prologue\n comments to agree with WNNLS. (RWC) 920501 Reformatted the REFERENCES section. (WRB) Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: me integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: iwork (*) real(kind=wp) :: work (*) Calls proc~~dwnnls~~CallsGraph proc~dwnnls bspline_defc_module::dwnnls proc~dwnlsm bspline_defc_module::dwnlsm proc~dwnnls->proc~dwnlsm proc~dasum bspline_blas_module::dasum proc~dwnlsm->proc~dasum proc~daxpy bspline_blas_module::daxpy proc~dwnlsm->proc~daxpy proc~dcopy bspline_blas_module::dcopy proc~dwnlsm->proc~dcopy proc~dh12 bspline_defc_module::dh12 proc~dwnlsm->proc~dh12 proc~dnrm2 bspline_blas_module::dnrm2 proc~dwnlsm->proc~dnrm2 proc~drotm bspline_blas_module::drotm proc~dwnlsm->proc~drotm proc~drotmg bspline_blas_module::drotmg proc~dwnlsm->proc~drotmg proc~dscal bspline_blas_module::dscal proc~dwnlsm->proc~dscal proc~dswap bspline_blas_module::dswap proc~dwnlsm->proc~dswap proc~dwnlit bspline_defc_module::dwnlit proc~dwnlsm->proc~dwnlit proc~idamax bspline_blas_module::idamax proc~dwnlsm->proc~idamax proc~dh12->proc~daxpy proc~dh12->proc~dswap proc~ddot bspline_blas_module::ddot proc~dh12->proc~ddot proc~dwnlit->proc~dcopy proc~dwnlit->proc~dh12 proc~dwnlit->proc~drotm proc~dwnlit->proc~drotmg proc~dwnlit->proc~dscal proc~dwnlit->proc~dswap proc~dwnlit->proc~idamax proc~dwnlt1 bspline_defc_module::dwnlt1 proc~dwnlit->proc~dwnlt1 proc~dwnlt2 bspline_defc_module::dwnlt2 proc~dwnlit->proc~dwnlt2 proc~dwnlt3 bspline_defc_module::dwnlt3 proc~dwnlit->proc~dwnlt3 proc~dwnlt1->proc~idamax proc~dwnlt3->proc~dswap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dwnnls~~CalledByGraph proc~dwnnls bspline_defc_module::dwnnls proc~dlpdp bspline_defc_module::dlpdp proc~dlpdp->proc~dwnnls proc~dlsi bspline_defc_module::dlsi proc~dlsi->proc~dlpdp proc~dlsei bspline_defc_module::dlsei proc~dlsei->proc~dlsi proc~dfcmn bspline_defc_module::dfcmn proc~dfcmn->proc~dlsei proc~dfc bspline_defc_module::dfc proc~dfc->proc~dfcmn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dwnnls ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , & iwork , work ) integer :: iwork ( * ), l , l1 , l2 , l3 , l4 , l5 , liw , lw , ma , mdw , me , & mode , n real ( wp ) :: prgopt ( * ), rnorm , w ( mdw , * ), work ( * ), x ( * ) character ( len = 8 ) :: xern1 mode = 0 if ( ma + me <= 0 . or . n <= 0 ) return if ( iwork ( 1 ) > 0 ) then lw = me + ma + 5 * n if ( iwork ( 1 ) < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WORK(*), NEED LW = ' // xern1 mode = 2 return endif endif if ( iwork ( 2 ) > 0 ) then liw = me + ma + n if ( iwork ( 2 ) < liw ) then write ( xern1 , '(I8)' ) liw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IWORK(*), NEED LIW = ' // xern1 mode = 2 return endif endif if ( mdw < me + ma ) then write ( * , * ) 'THE VALUE MDW n ) then write ( * , * ) 'L>=0 .AND. L<=N IS REQUIRED' mode = 2 return endif ! THE PURPOSE OF THIS SUBROUTINE IS TO BREAK UP THE ARRAYS ! WORK(*) AND IWORK(*) INTO SEPARATE WORK ARRAYS ! REQUIRED BY THE MAIN SUBROUTINE DWNLSM( ). l1 = n + 1 l2 = l1 + n l3 = l2 + me + ma l4 = l3 + n l5 = l4 + n call dwnlsm ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , iwork , & iwork ( l1 ), work ( 1 ), work ( l1 ), work ( l2 ), work ( l3 ), & work ( l4 ), work ( l5 )) end subroutine dwnnls","tags":"","loc":"proc/dwnnls.html"},{"title":"status_ok – bspline-fortran","text":"private elemental function status_ok(me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. If the class is initialized using a function constructor, then\nthis is the only way to know if it was properly initialized,\nsince those are pure functions with not output iflag arguments. If status_ok=.false. , then the error message can be\nobtained from the get_bspline_status_message routine. Note: after an error condition, the clear_bspline_flag routine\ncan be called to reset the iflag to 0. Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical Source Code elemental function status_ok ( me ) result ( ok ) implicit none class ( bspline_class ), intent ( in ) :: me logical :: ok ok = ( me % iflag == 0_ip ) end function status_ok","tags":"","loc":"proc/status_ok.html"},{"title":"get_bspline_status_message – bspline-fortran","text":"private pure function get_bspline_status_message(me, iflag) result(msg) Get the status message from a bspline_class routine call. If iflag is not included, then the one in the class is used (which\ncorresponds to the last routine called.)\nOtherwise, it will convert the\ninput iflag argument into the appropriate message. This is a wrapper for get_status_message . Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag Calls proc~~get_bspline_status_message~~CallsGraph proc~get_bspline_status_message bspline_oo_module::bspline_class%get_bspline_status_message proc~get_status_message bspline_sub_module::get_status_message proc~get_bspline_status_message->proc~get_status_message Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function get_bspline_status_message ( me , iflag ) result ( msg ) implicit none class ( bspline_class ), intent ( in ) :: me character ( len = :), allocatable :: msg !! status message associated with the flag integer ( ip ), intent ( in ), optional :: iflag !! the corresponding status code if ( present ( iflag )) then msg = get_status_message ( iflag ) else msg = get_status_message ( me % iflag ) end if end function get_bspline_status_message","tags":"","loc":"proc/get_bspline_status_message.html"},{"title":"size_1d – bspline-fortran","text":"private pure function size_1d(me) result(s) Actual size of a bspline_1d structure in bits. Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_1d ( me ) result ( s ) implicit none class ( bspline_1d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 2_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) end function size_1d","tags":"","loc":"proc/size_1d.html"},{"title":"size_2d – bspline-fortran","text":"private pure function size_2d(me) result(s) Actual size of a bspline_2d structure in bits. Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_2d ( me ) result ( s ) implicit none class ( bspline_2d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 6_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) end function size_2d","tags":"","loc":"proc/size_2d.html"},{"title":"size_3d – bspline-fortran","text":"private pure function size_3d(me) result(s) Actual size of a bspline_3d structure in bits. Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_3d ( me ) result ( s ) implicit none class ( bspline_3d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 10_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) end function size_3d","tags":"","loc":"proc/size_3d.html"},{"title":"size_4d – bspline-fortran","text":"private pure function size_4d(me) result(s) Actual size of a bspline_4d structure in bits. Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_4d ( me ) result ( s ) implicit none class ( bspline_4d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 14_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) end function size_4d","tags":"","loc":"proc/size_4d.html"},{"title":"size_5d – bspline-fortran","text":"private pure function size_5d(me) result(s) Actual size of a bspline_5d structure in bits. Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_5d ( me ) result ( s ) implicit none class ( bspline_5d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 18_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) end function size_5d","tags":"","loc":"proc/size_5d.html"},{"title":"size_6d – bspline-fortran","text":"private pure function size_6d(me) result(s) Actual size of a bspline_6d structure in bits. Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits Source Code pure function size_6d ( me ) result ( s ) implicit none class ( bspline_6d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 22_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) * & size ( me % bcoef , 6 , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % ts )) s = s + real_size * size ( me % ts , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) * & size ( me % work_val_1 , 5_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) * & size ( me % work_val_2 , 4_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) * & size ( me % work_val_3 , 3_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , 1_ip , kind = ip ) * & size ( me % work_val_4 , 2_ip , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) if ( allocated ( me % work_val_6 )) s = s + real_size * size ( me % work_val_6 , kind = ip ) end function size_6d","tags":"","loc":"proc/size_6d.html"},{"title":"bspline_1d_constructor_empty – bspline-fortran","text":"private pure elemental function bspline_1d_constructor_empty() result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) Called by proc~~bspline_1d_constructor_empty~~CalledByGraph proc~bspline_1d_constructor_empty bspline_oo_module::bspline_1d_constructor_empty interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental function bspline_1d_constructor_empty () result ( me ) implicit none type ( bspline_1d ) :: me end function bspline_1d_constructor_empty","tags":"","loc":"proc/bspline_1d_constructor_empty.html"},{"title":"bspline_1d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_1d_constructor_auto_knots(x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) Calls proc~~bspline_1d_constructor_auto_knots~~CallsGraph proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots->interface~db1ink proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_auto_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_1d_constructor_auto_knots~~CalledByGraph proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_1d_constructor_auto_knots ( x , fcn , kx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_auto_knots ( me , x , fcn , kx , me % iflag , extrap ) end function bspline_1d_constructor_auto_knots","tags":"","loc":"proc/bspline_1d_constructor_auto_knots.html"},{"title":"bspline_1d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_1d_constructor_specify_knots(x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) Calls proc~~bspline_1d_constructor_specify_knots~~CallsGraph proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_specify_knots->interface~db1ink proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_specify_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_1d_constructor_specify_knots~~CalledByGraph proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_1d_constructor_specify_knots ( x , fcn , kx , tx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_specify_knots ( me , x , fcn , kx , tx , me % iflag , extrap ) end function bspline_1d_constructor_specify_knots","tags":"","loc":"proc/bspline_1d_constructor_specify_knots.html"},{"title":"bspline_2d_constructor_empty – bspline-fortran","text":"private elemental function bspline_2d_constructor_empty() result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) Called by proc~~bspline_2d_constructor_empty~~CalledByGraph proc~bspline_2d_constructor_empty bspline_oo_module::bspline_2d_constructor_empty interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_2d_constructor_empty () result ( me ) implicit none type ( bspline_2d ) :: me end function bspline_2d_constructor_empty","tags":"","loc":"proc/bspline_2d_constructor_empty.html"},{"title":"bspline_2d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_2d_constructor_auto_knots(x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) Calls proc~~bspline_2d_constructor_auto_knots~~CallsGraph proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_auto_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_2d_constructor_auto_knots~~CalledByGraph proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_2d_constructor_auto_knots ( x , y , fcn , kx , ky , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , me % iflag , extrap ) end function bspline_2d_constructor_auto_knots","tags":"","loc":"proc/bspline_2d_constructor_auto_knots.html"},{"title":"bspline_2d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_2d_constructor_specify_knots(x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) Calls proc~~bspline_2d_constructor_specify_knots~~CallsGraph proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_specify_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_specify_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_2d_constructor_specify_knots~~CalledByGraph proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_2d_constructor_specify_knots ( x , y , fcn , kx , ky , tx , ty , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , me % iflag , extrap ) end function bspline_2d_constructor_specify_knots","tags":"","loc":"proc/bspline_2d_constructor_specify_knots.html"},{"title":"bspline_3d_constructor_empty – bspline-fortran","text":"private elemental function bspline_3d_constructor_empty() result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) Called by proc~~bspline_3d_constructor_empty~~CalledByGraph proc~bspline_3d_constructor_empty bspline_oo_module::bspline_3d_constructor_empty interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_3d_constructor_empty () result ( me ) implicit none type ( bspline_3d ) :: me end function bspline_3d_constructor_empty","tags":"","loc":"proc/bspline_3d_constructor_empty.html"},{"title":"bspline_3d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_3d_constructor_auto_knots(x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) Calls proc~~bspline_3d_constructor_auto_knots~~CallsGraph proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_auto_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_3d_constructor_auto_knots~~CalledByGraph proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_3d_constructor_auto_knots ( x , y , z , fcn , kx , ky , kz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , me % iflag , extrap ) end function bspline_3d_constructor_auto_knots","tags":"","loc":"proc/bspline_3d_constructor_auto_knots.html"},{"title":"bspline_3d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_3d_constructor_specify_knots(x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) Calls proc~~bspline_3d_constructor_specify_knots~~CallsGraph proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_specify_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_specify_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_3d_constructor_specify_knots~~CalledByGraph proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_3d_constructor_specify_knots ( x , y , z , fcn , kx , ky , kz , tx , ty , tz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , me % iflag , extrap ) end function bspline_3d_constructor_specify_knots","tags":"","loc":"proc/bspline_3d_constructor_specify_knots.html"},{"title":"bspline_4d_constructor_empty – bspline-fortran","text":"private elemental function bspline_4d_constructor_empty() result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) Called by proc~~bspline_4d_constructor_empty~~CalledByGraph proc~bspline_4d_constructor_empty bspline_oo_module::bspline_4d_constructor_empty interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_4d_constructor_empty () result ( me ) implicit none type ( bspline_4d ) :: me end function bspline_4d_constructor_empty","tags":"","loc":"proc/bspline_4d_constructor_empty.html"},{"title":"bspline_4d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_4d_constructor_auto_knots(x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) Calls proc~~bspline_4d_constructor_auto_knots~~CallsGraph proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_auto_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_4d_constructor_auto_knots~~CalledByGraph proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_4d_constructor_auto_knots ( x , y , z , q , fcn , kx , ky , kz , kq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , me % iflag , extrap ) end function bspline_4d_constructor_auto_knots","tags":"","loc":"proc/bspline_4d_constructor_auto_knots.html"},{"title":"bspline_4d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_4d_constructor_specify_knots(x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) Calls proc~~bspline_4d_constructor_specify_knots~~CallsGraph proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_specify_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_specify_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_4d_constructor_specify_knots~~CalledByGraph proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_4d_constructor_specify_knots ( x , y , z , q , fcn , kx , ky , kz , kq ,& tx , ty , tz , tq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_specify_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , tx , ty , tz , tq , me % iflag , extrap ) end function bspline_4d_constructor_specify_knots","tags":"","loc":"proc/bspline_4d_constructor_specify_knots.html"},{"title":"bspline_5d_constructor_empty – bspline-fortran","text":"private elemental function bspline_5d_constructor_empty() result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) Called by proc~~bspline_5d_constructor_empty~~CalledByGraph proc~bspline_5d_constructor_empty bspline_oo_module::bspline_5d_constructor_empty interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_5d_constructor_empty () result ( me ) implicit none type ( bspline_5d ) :: me end function bspline_5d_constructor_empty","tags":"","loc":"proc/bspline_5d_constructor_empty.html"},{"title":"bspline_5d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_5d_constructor_auto_knots(x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) Calls proc~~bspline_5d_constructor_auto_knots~~CallsGraph proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_auto_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_5d_constructor_auto_knots~~CalledByGraph proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_5d_constructor_auto_knots ( x , y , z , q , r , fcn , kx , ky , kz , kq , kr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , me % iflag , extrap ) end function bspline_5d_constructor_auto_knots","tags":"","loc":"proc/bspline_5d_constructor_auto_knots.html"},{"title":"bspline_5d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_5d_constructor_specify_knots(x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) Calls proc~~bspline_5d_constructor_specify_knots~~CallsGraph proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_specify_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_specify_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_5d_constructor_specify_knots~~CalledByGraph proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_5d_constructor_specify_knots ( x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_specify_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , tx , ty , tz , tq , tr , me % iflag , extrap ) end function bspline_5d_constructor_specify_knots","tags":"","loc":"proc/bspline_5d_constructor_specify_knots.html"},{"title":"bspline_6d_constructor_empty – bspline-fortran","text":"private elemental function bspline_6d_constructor_empty() result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) Called by proc~~bspline_6d_constructor_empty~~CalledByGraph proc~bspline_6d_constructor_empty bspline_oo_module::bspline_6d_constructor_empty interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_empty Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code elemental function bspline_6d_constructor_empty () result ( me ) implicit none type ( bspline_6d ) :: me end function bspline_6d_constructor_empty","tags":"","loc":"proc/bspline_6d_constructor_empty.html"},{"title":"bspline_6d_constructor_auto_knots – bspline-fortran","text":"private pure function bspline_6d_constructor_auto_knots(x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Calls proc~~bspline_6d_constructor_auto_knots~~CallsGraph proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_auto_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_6d_constructor_auto_knots~~CalledByGraph proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_6d_constructor_auto_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn , kx , ky , kz , kq , kr , ks , me % iflag , extrap ) end function bspline_6d_constructor_auto_knots","tags":"","loc":"proc/bspline_6d_constructor_auto_knots.html"},{"title":"bspline_6d_constructor_specify_knots – bspline-fortran","text":"private pure function bspline_6d_constructor_specify_knots(x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Calls proc~~bspline_6d_constructor_specify_knots~~CallsGraph proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_specify_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_specify_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~bspline_6d_constructor_specify_knots~~CalledByGraph proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function bspline_6d_constructor_specify_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , me % iflag , extrap ) end function bspline_6d_constructor_specify_knots","tags":"","loc":"proc/bspline_6d_constructor_specify_knots.html"},{"title":"clear_bspline_flag – bspline-fortran","text":"private elemental subroutine clear_bspline_flag(me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Source Code elemental subroutine clear_bspline_flag ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % iflag = 0_ip end subroutine clear_bspline_flag","tags":"","loc":"proc/clear_bspline_flag.html"},{"title":"destroy_base – bspline-fortran","text":"private pure subroutine destroy_base(me) Destructor for contents of the base bspline_class class.\n(this routine is called by the extended classes). Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Called by proc~~destroy_base~~CalledByGraph proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~destroy_1d->proc~destroy_base proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~destroy_2d->proc~destroy_base proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~destroy_3d->proc~destroy_base proc~finalize_1d bspline_oo_module::finalize_1d proc~finalize_1d->proc~destroy_1d proc~finalize_2d bspline_oo_module::finalize_2d proc~finalize_2d->proc~destroy_2d proc~finalize_3d bspline_oo_module::finalize_3d proc~finalize_3d->proc~destroy_3d proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->proc~destroy_1d proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~destroy_1d proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~destroy_2d proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~destroy_2d proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~destroy_3d proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~destroy_3d proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_base ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % inbvx = 1_ip me % iflag = 1_ip me % initialized = . false . me % extrap = . false . end subroutine destroy_base","tags":"","loc":"proc/destroy_base.html"},{"title":"destroy_1d – bspline-fortran","text":"private pure subroutine destroy_1d(me) Destructor for bspline_1d class. Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me Calls proc~~destroy_1d~~CallsGraph proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~destroy_1d~~CalledByGraph proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~finalize_1d bspline_oo_module::finalize_1d proc~finalize_1d->proc~destroy_1d proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->proc~destroy_1d proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~destroy_1d proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_1d ( me ) implicit none class ( bspline_1d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % kx = 0_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) end subroutine destroy_1d","tags":"","loc":"proc/destroy_1d.html"},{"title":"destroy_2d – bspline-fortran","text":"private pure subroutine destroy_2d(me) Destructor for bspline_2d class. Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me Calls proc~~destroy_2d~~CallsGraph proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~destroy_2d~~CalledByGraph proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~finalize_2d bspline_oo_module::finalize_2d proc~finalize_2d->proc~destroy_2d proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~destroy_2d proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~destroy_2d proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_2d ( me ) implicit none class ( bspline_2d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % kx = 0_ip me % ky = 0_ip me % inbvy = 1_ip me % iloy = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) end subroutine destroy_2d","tags":"","loc":"proc/destroy_2d.html"},{"title":"destroy_3d – bspline-fortran","text":"private pure subroutine destroy_3d(me) Destructor for bspline_3d class. Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me Calls proc~~destroy_3d~~CallsGraph proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~destroy_3d~~CalledByGraph proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~finalize_3d bspline_oo_module::finalize_3d proc~finalize_3d->proc~destroy_3d proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~destroy_3d proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~destroy_3d proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_3d ( me ) implicit none class ( bspline_3d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % iloy = 1_ip me % iloz = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) end subroutine destroy_3d","tags":"","loc":"proc/destroy_3d.html"},{"title":"destroy_4d – bspline-fortran","text":"private pure subroutine destroy_4d(me) Destructor for bspline_4d class. Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me Called by proc~~destroy_4d~~CalledByGraph proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~finalize_4d bspline_oo_module::finalize_4d proc~finalize_4d->proc~destroy_4d proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~destroy_4d proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~destroy_4d proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_4d ( me ) implicit none class ( bspline_4d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) end subroutine destroy_4d","tags":"","loc":"proc/destroy_4d.html"},{"title":"destroy_5d – bspline-fortran","text":"private pure subroutine destroy_5d(me) Destructor for bspline_5d class. Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me Called by proc~~destroy_5d~~CalledByGraph proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~finalize_5d bspline_oo_module::finalize_5d proc~finalize_5d->proc~destroy_5d proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~destroy_5d proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~destroy_5d proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_5d ( me ) implicit none class ( bspline_5d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) end subroutine destroy_5d","tags":"","loc":"proc/destroy_5d.html"},{"title":"destroy_6d – bspline-fortran","text":"private pure subroutine destroy_6d(me) Destructor for bspline_6d class. Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me Called by proc~~destroy_6d~~CalledByGraph proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~finalize_6d bspline_oo_module::finalize_6d proc~finalize_6d->proc~destroy_6d proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~destroy_6d proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~destroy_6d proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine destroy_6d ( me ) implicit none class ( bspline_6d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % ns = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % ks = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % inbvs = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip me % ilos = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % ts )) deallocate ( me % ts ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) if ( allocated ( me % work_val_6 )) deallocate ( me % work_val_6 ) end subroutine destroy_6d","tags":"","loc":"proc/destroy_6d.html"},{"title":"finalize_1d – bspline-fortran","text":"private pure elemental subroutine finalize_1d(me) Finalizer for bspline_1d class. Just a wrapper for destroy_1d . Arguments Type Intent Optional Attributes Name type( bspline_1d ), intent(inout) :: me Calls proc~~finalize_1d~~CallsGraph proc~finalize_1d bspline_oo_module::finalize_1d proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~finalize_1d->proc~destroy_1d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_1d ( me ) type ( bspline_1d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_1d","tags":"","loc":"proc/finalize_1d.html"},{"title":"finalize_2d – bspline-fortran","text":"private pure elemental subroutine finalize_2d(me) Finalizer for bspline_2d class. Just a wrapper for destroy_2d . Arguments Type Intent Optional Attributes Name type( bspline_2d ), intent(inout) :: me Calls proc~~finalize_2d~~CallsGraph proc~finalize_2d bspline_oo_module::finalize_2d proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~finalize_2d->proc~destroy_2d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_2d ( me ) type ( bspline_2d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_2d","tags":"","loc":"proc/finalize_2d.html"},{"title":"finalize_3d – bspline-fortran","text":"private pure elemental subroutine finalize_3d(me) Finalizer for bspline_3d class. Just a wrapper for destroy_3d . Arguments Type Intent Optional Attributes Name type( bspline_3d ), intent(inout) :: me Calls proc~~finalize_3d~~CallsGraph proc~finalize_3d bspline_oo_module::finalize_3d proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~finalize_3d->proc~destroy_3d proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_3d ( me ) type ( bspline_3d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_3d","tags":"","loc":"proc/finalize_3d.html"},{"title":"finalize_4d – bspline-fortran","text":"private pure elemental subroutine finalize_4d(me) Finalizer for bspline_4d class. Just a wrapper for destroy_4d . Arguments Type Intent Optional Attributes Name type( bspline_4d ), intent(inout) :: me Calls proc~~finalize_4d~~CallsGraph proc~finalize_4d bspline_oo_module::finalize_4d proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~finalize_4d->proc~destroy_4d Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_4d ( me ) type ( bspline_4d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_4d","tags":"","loc":"proc/finalize_4d.html"},{"title":"finalize_5d – bspline-fortran","text":"private pure elemental subroutine finalize_5d(me) Finalizer for bspline_5d class. Just a wrapper for destroy_5d . Arguments Type Intent Optional Attributes Name type( bspline_5d ), intent(inout) :: me Calls proc~~finalize_5d~~CallsGraph proc~finalize_5d bspline_oo_module::finalize_5d proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~finalize_5d->proc~destroy_5d Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_5d ( me ) type ( bspline_5d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_5d","tags":"","loc":"proc/finalize_5d.html"},{"title":"finalize_6d – bspline-fortran","text":"private pure elemental subroutine finalize_6d(me) Finalizer for bspline_6d class. Just a wrapper for destroy_6d . Arguments Type Intent Optional Attributes Name type( bspline_6d ), intent(inout) :: me Calls proc~~finalize_6d~~CallsGraph proc~finalize_6d bspline_oo_module::finalize_6d proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~finalize_6d->proc~destroy_6d Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine finalize_6d ( me ) type ( bspline_6d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_6d","tags":"","loc":"proc/finalize_6d.html"},{"title":"set_extrap_flag – bspline-fortran","text":"private pure subroutine set_extrap_flag(me, extrap) Sets the extrap flag in the class. Type Bound bspline_class Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me logical, intent(in), optional :: extrap if not present, then False is used Called by proc~~set_extrap_flag~~CalledByGraph proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine set_extrap_flag ( me , extrap ) implicit none class ( bspline_class ), intent ( inout ) :: me logical , intent ( in ), optional :: extrap !! if not present, then False is used if ( present ( extrap )) then me % extrap = extrap else me % extrap = . false . end if end subroutine set_extrap_flag","tags":"","loc":"proc/set_extrap_flag.html"},{"title":"initialize_1d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_1d_auto_knots(me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_1d_auto_knots~~CallsGraph proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots->interface~db1ink proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_auto_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_1d_auto_knots~~CalledByGraph proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_1d_auto_knots ( me , x , fcn , kx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) iknot = 0_ip !knot sequence chosen by db1ink call db1ink ( x , nx , fcn , kx , iknot , me % tx , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_auto_knots","tags":"","loc":"proc/initialize_1d_auto_knots.html"},{"title":"initialize_1d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_1d_specify_knots(me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_1d_specify_knots~~CallsGraph proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_specify_knots->interface~db1ink proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_specify_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_1d_specify_knots~~CalledByGraph proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_1d_specify_knots ( me , x , fcn , kx , tx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx , iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) me % tx = tx call db1ink ( x , nx , fcn , kx , 1_ip , me % tx , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_specify_knots","tags":"","loc":"proc/initialize_1d_specify_knots.html"},{"title":"evaluate_1d – bspline-fortran","text":"private pure subroutine evaluate_1d(me, xval, idx, f, iflag) Evaluate a bspline_1d interpolate. This is a wrapper for db1val . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db1val ) Calls proc~~evaluate_1d~~CallsGraph proc~evaluate_1d bspline_oo_module::bspline_1d%evaluate_1d interface~db1val bspline_sub_module::db1val proc~evaluate_1d->interface~db1val proc~db1val_alt bspline_sub_module::db1val_alt interface~db1val->proc~db1val_alt proc~db1val_default bspline_sub_module::db1val_default interface~db1val->proc~db1val_default proc~check_value bspline_sub_module::check_value proc~db1val_alt->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db1val_alt->proc~dbvalu proc~db1val_default->proc~check_value proc~db1val_default->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_1d ( me , xval , idx , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1val]]) if ( me % initialized ) then call db1val ( xval , idx , me % tx , me % nx , me % kx , me % bcoef , f , iflag ,& me % inbvx , me % work_val_1 , extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_1d","tags":"","loc":"proc/evaluate_1d.html"},{"title":"integral_1d – bspline-fortran","text":"private pure subroutine integral_1d(me, x1, x2, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1sqad . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(out) :: f integral of the b-spline over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) Calls proc~~integral_1d~~CallsGraph proc~integral_1d bspline_oo_module::bspline_1d%integral_1d proc~db1sqad bspline_sub_module::db1sqad proc~integral_1d->proc~db1sqad proc~dbsqad bspline_sub_module::dbsqad proc~db1sqad->proc~dbsqad proc~dbvalu bspline_sub_module::dbvalu proc~dbsqad->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~dbsqad->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine integral_1d ( me , x1 , x2 , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( out ) :: f !! integral of the b-spline over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1sqad ( me % tx , me % bcoef , me % nx , me % kx , x1 , x2 , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine integral_1d","tags":"","loc":"proc/integral_1d.html"},{"title":"fintegral_1d – bspline-fortran","text":"private subroutine fintegral_1d(me, fun, idx, x1, x2, tol, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1fqad . Type Bound bspline_1d Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv) integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(in) :: tol desired accuracy for the quadrature real(kind=wp), intent(out) :: f integral of bf(x) over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) Calls proc~~fintegral_1d~~CallsGraph proc~fintegral_1d bspline_oo_module::bspline_1d%fintegral_1d proc~db1fqad bspline_sub_module::db1fqad proc~fintegral_1d->proc~db1fqad proc~dbfqad bspline_sub_module::dbfqad proc~db1fqad->proc~dbfqad proc~dbsgq8 bspline_sub_module::dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dintrv bspline_sub_module::dintrv proc~dbfqad->proc~dintrv proc~dbvalu bspline_sub_module::dbvalu proc~dbsgq8->proc~dbvalu proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap proc~dbvalu->proc~dintrv Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine fintegral_1d ( me , fun , idx , x1 , x2 , tol , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv)` integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature real ( wp ), intent ( out ) :: f !! integral of `bf(x)` over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1fqad ( fun , me % tx , me % bcoef , me % nx , me % kx , idx , x1 , x2 , tol , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine fintegral_1d","tags":"","loc":"proc/fintegral_1d.html"},{"title":"initialize_2d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_2d_auto_knots(me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_2d_auto_knots~~CallsGraph proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_auto_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_2d_auto_knots~~CalledByGraph proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) iknot = 0_ip !knot sequence chosen by db2ink call db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , me % tx , me % ty , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_auto_knots","tags":"","loc":"proc/initialize_2d_auto_knots.html"},{"title":"initialize_2d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_2d_specify_knots(me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_2d_specify_knots~~CallsGraph proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_specify_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_specify_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_2d_specify_knots~~CalledByGraph proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) me % tx = tx me % ty = ty call db2ink ( x , nx , y , ny , fcn , kx , ky , 1_ip , me % tx , me % ty , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_specify_knots","tags":"","loc":"proc/initialize_2d_specify_knots.html"},{"title":"evaluate_2d – bspline-fortran","text":"private pure subroutine evaluate_2d(me, xval, yval, idx, idy, f, iflag) Evaluate a bspline_2d interpolate. This is a wrapper for db2val . Type Bound bspline_2d Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db2val ) Calls proc~~evaluate_2d~~CallsGraph proc~evaluate_2d bspline_oo_module::bspline_2d%evaluate_2d proc~db2val bspline_sub_module::db2val proc~evaluate_2d->proc~db2val proc~check_value bspline_sub_module::check_value proc~db2val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db2val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db2val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_2d ( me , xval , yval , idx , idy , f , iflag ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2val]]) if ( me % initialized ) then call db2val ( xval , yval ,& idx , idy ,& me % tx , me % ty ,& me % nx , me % ny ,& me % kx , me % ky ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % iloy ,& me % work_val_1 , me % work_val_2 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_2d","tags":"","loc":"proc/evaluate_2d.html"},{"title":"initialize_3d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_3d_auto_knots(me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_3d_auto_knots~~CallsGraph proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_auto_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_3d_auto_knots~~CalledByGraph proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) iknot = 0_ip !knot sequence chosen by db3ink call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& iknot ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_auto_knots","tags":"","loc":"proc/initialize_3d_auto_knots.html"},{"title":"initialize_3d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_3d_specify_knots(me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_3d_specify_knots~~CallsGraph proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_specify_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_specify_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_3d_specify_knots~~CalledByGraph proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) me % tx = tx me % ty = ty me % tz = tz call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& 1_ip ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_specify_knots","tags":"","loc":"proc/initialize_3d_specify_knots.html"},{"title":"evaluate_3d – bspline-fortran","text":"private pure subroutine evaluate_3d(me, xval, yval, zval, idx, idy, idz, f, iflag) Evaluate a bspline_3d interpolate. This is a wrapper for db3val . Type Bound bspline_3d Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db3val ) Calls proc~~evaluate_3d~~CallsGraph proc~evaluate_3d bspline_oo_module::bspline_3d%evaluate_3d proc~db3val bspline_sub_module::db3val proc~evaluate_3d->proc~db3val proc~check_value bspline_sub_module::check_value proc~db3val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db3val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db3val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_3d ( me , xval , yval , zval , idx , idy , idz , f , iflag ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3val]]) if ( me % initialized ) then call db3val ( xval , yval , zval ,& idx , idy , idz ,& me % tx , me % ty , me % tz ,& me % nx , me % ny , me % nz ,& me % kx , me % ky , me % kz ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz ,& me % iloy , me % iloz ,& me % work_val_1 , me % work_val_2 , me % work_val_3 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_3d","tags":"","loc":"proc/evaluate_3d.html"},{"title":"initialize_4d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_4d_auto_knots(me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_4d_auto_knots~~CallsGraph proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_auto_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_4d_auto_knots~~CalledByGraph proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) iknot = 0_ip !knot sequence chosen by db4ink call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_auto_knots","tags":"","loc":"proc/initialize_4d_auto_knots.html"},{"title":"initialize_4d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_4d_specify_knots(me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_4d_specify_knots~~CallsGraph proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_specify_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_specify_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_4d_specify_knots~~CalledByGraph proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_4d_specify_knots ( me , x , y , z , q , fcn ,& kx , ky , kz , kq , tx , ty , tz , tq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_specify_knots","tags":"","loc":"proc/initialize_4d_specify_knots.html"},{"title":"evaluate_4d – bspline-fortran","text":"private pure subroutine evaluate_4d(me, xval, yval, zval, qval, idx, idy, idz, idq, f, iflag) Evaluate a bspline_4d interpolate. This is a wrapper for db4val . Type Bound bspline_4d Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db4val ) Calls proc~~evaluate_4d~~CallsGraph proc~evaluate_4d bspline_oo_module::bspline_4d%evaluate_4d proc~db4val bspline_sub_module::db4val proc~evaluate_4d->proc~db4val proc~check_value bspline_sub_module::check_value proc~db4val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db4val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db4val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_4d ( me , xval , yval , zval , qval , idx , idy , idz , idq , f , iflag ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4val]]) if ( me % initialized ) then call db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& me % tx , me % ty , me % tz , me % tq ,& me % nx , me % ny , me % nz , me % nq ,& me % kx , me % ky , me % kz , me % kq ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq ,& me % iloy , me % iloz , me % iloq ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_4d","tags":"","loc":"proc/evaluate_4d.html"},{"title":"initialize_5d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_5d_auto_knots(me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_5d_auto_knots~~CallsGraph proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_auto_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_5d_auto_knots~~CalledByGraph proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) iknot = 0_ip !knot sequence chosen by db5ink call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_auto_knots","tags":"","loc":"proc/initialize_5d_auto_knots.html"},{"title":"initialize_5d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_5d_specify_knots(me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_5d_specify_knots~~CallsGraph proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_specify_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_specify_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_5d_specify_knots~~CalledByGraph proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_5d_specify_knots ( me , x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_specify_knots","tags":"","loc":"proc/initialize_5d_specify_knots.html"},{"title":"evaluate_5d – bspline-fortran","text":"private pure subroutine evaluate_5d(me, xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, f, iflag) Evaluate a bspline_5d interpolate. This is a wrapper for db5val . Type Bound bspline_5d Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db5val ) Calls proc~~evaluate_5d~~CallsGraph proc~evaluate_5d bspline_oo_module::bspline_5d%evaluate_5d proc~db5val bspline_sub_module::db5val proc~evaluate_5d->proc~db5val proc~check_value bspline_sub_module::check_value proc~db5val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db5val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db5val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_5d ( me , xval , yval , zval , qval , rval , idx , idy , idz , idq , idr , f , iflag ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5val]]) if ( me % initialized ) then call db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % nx , me % ny , me % nz , me % nq , me % nr ,& me % kx , me % ky , me % kz , me % kq , me % kr ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr ,& me % iloy , me % iloz , me % iloq , me % ilor ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_5d","tags":"","loc":"proc/evaluate_5d.html"},{"title":"initialize_6d_auto_knots – bspline-fortran","text":"private pure subroutine initialize_6d_auto_knots(me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_6d_auto_knots~~CallsGraph proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_auto_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_6d_auto_knots~~CalledByGraph proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) iknot = 0_ip !knot sequence chosen by db6ink call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_auto_knots","tags":"","loc":"proc/initialize_6d_auto_knots.html"},{"title":"initialize_6d_specify_knots – bspline-fortran","text":"private pure subroutine initialize_6d_specify_knots(me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Calls proc~~initialize_6d_specify_knots~~CallsGraph proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_specify_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_specify_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~initialize_6d_specify_knots~~CalledByGraph proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& ns = ns , ks = ks , ts = ts ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr me % ts = ts call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_specify_knots","tags":"","loc":"proc/initialize_6d_specify_knots.html"},{"title":"evaluate_6d – bspline-fortran","text":"private pure subroutine evaluate_6d(me, xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, f, iflag) Evaluate a bspline_6d interpolate. This is a wrapper for db6val . Type Bound bspline_6d Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db6val ) Calls proc~~evaluate_6d~~CallsGraph proc~evaluate_6d bspline_oo_module::bspline_6d%evaluate_6d proc~db6val bspline_sub_module::db6val proc~evaluate_6d->proc~db6val proc~check_value bspline_sub_module::check_value proc~db6val->proc~check_value proc~dbvalu bspline_sub_module::dbvalu proc~db6val->proc~dbvalu proc~dintrv bspline_sub_module::dintrv proc~db6val->proc~dintrv proc~dbvalu->proc~dintrv proc~get_temp_x_for_extrap bspline_sub_module::get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine evaluate_6d ( me , xval , yval , zval , qval , rval , sval , idx , idy , idz , idq , idr , ids , f , iflag ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6val]]) if ( me % initialized ) then call db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % nx , me % ny , me % nz , me % nq , me % nr , me % ns ,& me % kx , me % ky , me % kz , me % kq , me % kr , me % ks ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr , me % inbvs ,& me % iloy , me % iloz , me % iloq , me % ilor , me % ilos ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 , me % work_val_6 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_6d","tags":"","loc":"proc/evaluate_6d.html"},{"title":"check_knot_vectors_sizes – bspline-fortran","text":"private pure subroutine check_knot_vectors_sizes(nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag) Error checks for the user-specified knot vector sizes. Note If more than one is the wrong size, then the iflag error code will\n correspond to the one with the highest rank. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts integer(kind=ip), intent(out) :: iflag 0 if everything is OK Called by proc~~check_knot_vectors_sizes~~CalledByGraph proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_specify_knots interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_specify_knots Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure subroutine check_knot_vectors_sizes ( nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag ) implicit none integer ( ip ), intent ( in ), optional :: nx integer ( ip ), intent ( in ), optional :: ny integer ( ip ), intent ( in ), optional :: nz integer ( ip ), intent ( in ), optional :: nq integer ( ip ), intent ( in ), optional :: nr integer ( ip ), intent ( in ), optional :: ns integer ( ip ), intent ( in ), optional :: kx integer ( ip ), intent ( in ), optional :: ky integer ( ip ), intent ( in ), optional :: kz integer ( ip ), intent ( in ), optional :: kq integer ( ip ), intent ( in ), optional :: kr integer ( ip ), intent ( in ), optional :: ks real ( wp ), dimension (:), intent ( in ), optional :: tx real ( wp ), dimension (:), intent ( in ), optional :: ty real ( wp ), dimension (:), intent ( in ), optional :: tz real ( wp ), dimension (:), intent ( in ), optional :: tq real ( wp ), dimension (:), intent ( in ), optional :: tr real ( wp ), dimension (:), intent ( in ), optional :: ts integer ( ip ), intent ( out ) :: iflag !! 0 if everything is OK iflag = 0_ip if ( present ( nx ) . and . present ( kx ) . and . present ( tx )) then if ( size ( tx , kind = ip ) /= ( nx + kx )) then iflag = 501_ip ! tx is not the correct size (nx+kx) end if end if if ( present ( ny ) . and . present ( ky ) . and . present ( ty )) then if ( size ( ty , kind = ip ) /= ( ny + ky )) then iflag = 502_ip ! ty is not the correct size (ny+ky) end if end if if ( present ( nz ) . and . present ( kz ) . and . present ( tz )) then if ( size ( tz , kind = ip ) /= ( nz + kz )) then iflag = 503_ip ! tz is not the correct size (nz+kz) end if end if if ( present ( nq ) . and . present ( kq ) . and . present ( tq )) then if ( size ( tq , kind = ip ) /= ( nq + kq )) then iflag = 504_ip ! tq is not the correct size (nq+kq) end if end if if ( present ( nr ) . and . present ( kr ) . and . present ( tr )) then if ( size ( tr , kind = ip ) /= ( nr + kr )) then iflag = 505_ip ! tr is not the correct size (nr+kr) end if end if if ( present ( ns ) . and . present ( ks ) . and . present ( ts )) then if ( size ( ts , kind = ip ) /= ( ns + ks )) then iflag = 506_ip ! ts is not the correct size (ns+ks) end if end if end subroutine check_knot_vectors_sizes","tags":"","loc":"proc/check_knot_vectors_sizes.html"},{"title":"bspline_1d – bspline-fortran","text":"public interface bspline_1d Constructor for bspline_1d Calls interface~~bspline_1d~~CallsGraph interface~bspline_1d bspline_oo_module::bspline_1d proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_empty bspline_oo_module::bspline_1d_constructor_empty interface~bspline_1d->proc~bspline_1d_constructor_empty proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~db1ink bspline_sub_module::db1ink proc~initialize_1d_auto_knots->interface~db1ink proc~destroy_1d bspline_oo_module::bspline_1d%destroy_1d proc~initialize_1d_auto_knots->proc~destroy_1d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_1d_auto_knots->proc~set_extrap_flag proc~initialize_1d_specify_knots->interface~db1ink proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_1d_specify_knots->proc~destroy_1d proc~initialize_1d_specify_knots->proc~set_extrap_flag proc~db1ink_alt bspline_sub_module::db1ink_alt interface~db1ink->proc~db1ink_alt proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 interface~db1ink->proc~db1ink_alt_2 proc~db1ink_default bspline_sub_module::db1ink_default interface~db1ink->proc~db1ink_default proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_1d->proc~destroy_base proc~check_inputs bspline_sub_module::check_inputs proc~db1ink_alt->proc~check_inputs proc~dbint4 bspline_sub_module::dbint4 proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2->proc~check_inputs proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db1ink_default->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db1ink_default->proc~dbtpcf proc~dbnfac bspline_sub_module::dbnfac proc~dbint4->proc~dbnfac proc~dbnslv bspline_sub_module::dbnslv proc~dbint4->proc~dbnslv proc~dbspvd bspline_sub_module::dbspvd proc~dbint4->proc~dbspvd proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnfac proc~dbintk->proc~dbnslv proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn proc~dbspvd->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d )","tags":"","loc":"interface/bspline_1d.html"},{"title":"bspline_2d – bspline-fortran","text":"public interface bspline_2d Constructor for bspline_2d Calls interface~~bspline_2d~~CallsGraph interface~bspline_2d bspline_oo_module::bspline_2d proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_empty bspline_oo_module::bspline_2d_constructor_empty interface~bspline_2d->proc~bspline_2d_constructor_empty proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~db2ink bspline_sub_module::db2ink proc~initialize_2d_auto_knots->proc~db2ink proc~destroy_2d bspline_oo_module::bspline_2d%destroy_2d proc~initialize_2d_auto_knots->proc~destroy_2d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_2d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_2d_specify_knots->proc~destroy_2d proc~initialize_2d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db2ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db2ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db2ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_2d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d )","tags":"","loc":"interface/bspline_2d.html"},{"title":"bspline_3d – bspline-fortran","text":"public interface bspline_3d Constructor for bspline_3d Calls interface~~bspline_3d~~CallsGraph interface~bspline_3d bspline_oo_module::bspline_3d proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_empty bspline_oo_module::bspline_3d_constructor_empty interface~bspline_3d->proc~bspline_3d_constructor_empty proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~db3ink bspline_sub_module::db3ink proc~initialize_3d_auto_knots->proc~db3ink proc~destroy_3d bspline_oo_module::bspline_3d%destroy_3d proc~initialize_3d_auto_knots->proc~destroy_3d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_3d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_3d_specify_knots->proc~destroy_3d proc~initialize_3d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db3ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db3ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db3ink->proc~dbtpcf proc~destroy_base bspline_oo_module::bspline_class%destroy_base proc~destroy_3d->proc~destroy_base proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d )","tags":"","loc":"interface/bspline_3d.html"},{"title":"bspline_4d – bspline-fortran","text":"public interface bspline_4d Constructor for bspline_4d Calls interface~~bspline_4d~~CallsGraph interface~bspline_4d bspline_oo_module::bspline_4d proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_empty bspline_oo_module::bspline_4d_constructor_empty interface~bspline_4d->proc~bspline_4d_constructor_empty proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~db4ink bspline_sub_module::db4ink proc~initialize_4d_auto_knots->proc~db4ink proc~destroy_4d bspline_oo_module::bspline_4d%destroy_4d proc~initialize_4d_auto_knots->proc~destroy_4d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_4d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_4d_specify_knots->proc~destroy_4d proc~initialize_4d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db4ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db4ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db4ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d )","tags":"","loc":"interface/bspline_4d.html"},{"title":"bspline_5d – bspline-fortran","text":"public interface bspline_5d Constructor for bspline_5d Calls interface~~bspline_5d~~CallsGraph interface~bspline_5d bspline_oo_module::bspline_5d proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_empty bspline_oo_module::bspline_5d_constructor_empty interface~bspline_5d->proc~bspline_5d_constructor_empty proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~db5ink bspline_sub_module::db5ink proc~initialize_5d_auto_knots->proc~db5ink proc~destroy_5d bspline_oo_module::bspline_5d%destroy_5d proc~initialize_5d_auto_knots->proc~destroy_5d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_5d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_5d_specify_knots->proc~destroy_5d proc~initialize_5d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db5ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db5ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db5ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d )","tags":"","loc":"interface/bspline_5d.html"},{"title":"bspline_6d – bspline-fortran","text":"public interface bspline_6d Constructor for bspline_6d Calls interface~~bspline_6d~~CallsGraph interface~bspline_6d bspline_oo_module::bspline_6d proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_empty bspline_oo_module::bspline_6d_constructor_empty interface~bspline_6d->proc~bspline_6d_constructor_empty proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~db6ink bspline_sub_module::db6ink proc~initialize_6d_auto_knots->proc~db6ink proc~destroy_6d bspline_oo_module::bspline_6d%destroy_6d proc~initialize_6d_auto_knots->proc~destroy_6d proc~set_extrap_flag bspline_oo_module::bspline_class%set_extrap_flag proc~initialize_6d_auto_knots->proc~set_extrap_flag proc~check_knot_vectors_sizes bspline_oo_module::check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~check_knot_vectors_sizes proc~initialize_6d_specify_knots->proc~db6ink proc~initialize_6d_specify_knots->proc~destroy_6d proc~initialize_6d_specify_knots->proc~set_extrap_flag proc~check_inputs bspline_sub_module::check_inputs proc~db6ink->proc~check_inputs proc~dbknot bspline_sub_module::dbknot proc~db6ink->proc~dbknot proc~dbtpcf bspline_sub_module::dbtpcf proc~db6ink->proc~dbtpcf proc~dbintk bspline_sub_module::dbintk proc~dbtpcf->proc~dbintk proc~dbnslv bspline_sub_module::dbnslv proc~dbtpcf->proc~dbnslv proc~dbintk->proc~dbnslv proc~dbnfac bspline_sub_module::dbnfac proc~dbintk->proc~dbnfac proc~dbspvn bspline_sub_module::dbspvn proc~dbintk->proc~dbspvn Help Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d )","tags":"","loc":"interface/bspline_6d.html"},{"title":"bspline_sub_module – bspline-fortran","text":"Description Multidimensional (1D-6D) B-spline interpolation of data on a regular grid.\n Basic pure subroutine interface. Notes This module is based on the B-spline and spline routines from [1].\n The original Fortran 77 routines were converted to free-form source.\n Some of them are relatively unchanged from the originals, but some have\n been extensively refactored. In addition, new routines for\n 1d, 4d, 5d, and 6d interpolation were also created (these are simply\n extensions of the same algorithm into higher dimensions). See also An object-oriented interface can be found in bspline_oo_module . References DBSPLIN and DTENSBS from the NIST Core Math Library .\n Original code is public domain. Carl de Boor, \"A Practical Guide to Splines\",\n Springer-Verlag, New York, 1978. Carl de Boor, Efficient Computer Manipulation of Tensor\n Products ,\n ACM Transactions on Mathematical Software,\n Vol. 5 (1979), p. 173-182. D.E. Amos, \"Computation with Splines and B-Splines\",\n SAND78-1968, Sandia Laboratories, March, 1979. Carl de Boor, Package for calculating with B-splines ,\n SIAM Journal on Numerical Analysis 14, 3 (June 1977), p. 441-472. D.E. Amos, \"Quadrature subroutines for splines and B-splines\",\n Report SAND79-1825, Sandia Laboratories, December 1979. Uses bspline_kinds_module iso_fortran_env module~~bspline_sub_module~~UsesGraph module~bspline_sub_module bspline_sub_module iso_fortran_env iso_fortran_env module~bspline_sub_module->iso_fortran_env module~bspline_kinds_module bspline_kinds_module module~bspline_sub_module->module~bspline_kinds_module module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_sub_module~~UsedByGraph module~bspline_sub_module bspline_sub_module module~bspline_module bspline_module module~bspline_module->module~bspline_sub_module module~bspline_oo_module bspline_oo_module module~bspline_module->module~bspline_oo_module module~bspline_oo_module->module~bspline_sub_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer(kind=ip), public, parameter :: bspline_order_linear = 2_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_quadratic = 3_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_cubic = 4_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_quartic = 5_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_quintic = 6_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_hexic = 7_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_heptic = 8_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] integer(kind=ip), public, parameter :: bspline_order_octic = 9_ip spline order k parameter\n(for input to the db*ink routines)\n[order = polynomial degree + 1] Interfaces public interface db1ink 1D initialization routines. private pure subroutine db1ink_default (x, nx, fcn, kx, iknot, tx, bcoef, iflag) Determines the parameters of a function that interpolates\n the one-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db1val . History Jacob Williams, 10/30/2015 : Created 1D routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant: Read more… real(kind=wp), intent(out), dimension(:) :: bcoef (nx) array of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt_2 (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. History Jacob Williams, 9/4/2018 : created this routine. See also dbint4 -- the main routine that is called here. Note Currently, this only works for 3rd order (k=4). Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… public interface db1val 1D evaluation routines. private pure subroutine db1val_default (xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . To evaluate the interpolant itself, set idx=0 ,\n to evaluate the first partial with respect to x , set idx=1 , and so on. db1val returns 0.0 if ( xval , yval ) is out of range. that is, if xval < tx ( 1 ) . or . xval > tx ( nx + kx ) if the knots tx were chosen by db1ink , then this is equivalent to: xval < x ( 1 ) . or . xval > x ( nx ) + epsx where epsx = 0.1 * ( x ( nx ) - x ( nx - 1 )) The input quantities tx , nx , kx , and bcoef should be\n unchanged since the last call of db1ink . History Jacob Williams, 10/30/2015 : Created 1D routine. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine db1val_alt (xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Abstract Interfaces abstract interface public function b1fqad_func(x) result(f) interface for the input function in dbfqad Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x Return Value real(kind=wp) f(x) Functions private pure function check_value (x, t, i, extrap) result(iflag) Checks if the value is withing the range of the knot vectors.\nThis is called by the various db*val routines. Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x the value to check real(kind=wp), intent(in), dimension(:) :: t the knot vector integer(kind=ip), intent(in) :: i 1=x, 2=y, 3=z, 4=q, 5=r, 6=s logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value integer(kind=ip) returns 0 if value is OK, otherwise returns 600+i private pure function get_temp_x_for_extrap (x, tmin, tmax, extrap) result(xt) Returns the value of x to use for computing the interval\nin t , depending on if extrapolation is allowed or not. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: x variable value real(kind=wp), intent(in) :: tmin first knot vector element for b-splines real(kind=wp), intent(in) :: tmax last knot vector element for b-splines logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) Return Value real(kind=wp) The value returned (it will either\nbe tmin , x , or tmax ) public pure function get_status_message (iflag) result(msg) Returns a message string associated with the status code. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iflag return code from one of the routines Return Value character(len=:), allocatable status message associated with the flag Subroutines private pure subroutine db1ink_default (x, nx, fcn, kx, iknot, tx, bcoef, iflag) Determines the parameters of a function that interpolates\n the one-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db1val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant: Read more… real(kind=wp), intent(out), dimension(:) :: bcoef (nx) array of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, kntopt, tx, bcoef, iflag) Alternate version of db1ink_default , where the boundary conditions can be specified. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1ink_alt_2 (x, nx, fcn, kx, ibcl, ibcr, fbcl, fbcr, tleft, tright, tx, bcoef, iflag) Alternate version of db1ink_alt , where the first and\n last 3 knots are specified by the user. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x vector of abscissae of length nx , distinct\nand in increasing order integer(kind=ip), intent(in) :: nx number of data points, real(kind=wp), intent(in), dimension(:) :: fcn vector of ordinates of length nx integer(kind=ip), intent(in) :: kx spline order (Currently, this must be 4 ) integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr real(kind=wp), intent(in), dimension(3) :: tleft t(1:3) in increasing order supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright t(nx+4:nx+6) in increasing order supplied by the user. real(kind=wp), intent(out), dimension(:) :: tx knot array of length nx+6 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length nx+2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine db1val_default (xval, idx, tx, nx, kx, bcoef, f, iflag, inbvx, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db1ink or one of its\n derivatives at the point xval . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db1ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db1ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(nx) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine db1val_alt (xval, idx, tx, nx, n, kx, bcoef, f, iflag, inbvx, w0, extrap) Alternate version of db1val_default for use with db1ink_alt and db1ink_alt_2 . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(n+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. integer(kind=ip), intent(in) :: nx the number of interpolation points in . integer(kind=ip), intent(in) :: n length of bcoef : nx+2 integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db1ink ) real(kind=wp), intent(in), dimension(n) :: bcoef the b-spline coefficients computed by db1ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db1sqad (tx, bcoef, nx, kx, x1, x2, f, iflag, w0) Computes the integral on (x1,x2) of a kx -th order b-spline.\n Orders kx as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(kx) <= x <= t(nx+1) real(kind=wp), intent(out) :: f integral of the b-spline over ( x1 , x2 ) integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(inout), dimension(3*kx) :: w0 work array for dbsqad public subroutine db1fqad (fun, tx, bcoef, nx, kx, idx, x1, x2, tol, f, iflag, w0) Computes the integral on (x1,x2) of a product of a\n function fun and the idx -th derivative of a kx -th order b-spline,\n using the b-representation (tx,bcoef,nx,kx) , with an adaptive\n 8-point Legendre-Gauss algorithm. (x1,x2) must be a subinterval of t(kx) <= x <= t(nx+1) . Read more… Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work) real(kind=wp), intent(in), dimension(nx+kx) :: tx knot array real(kind=wp), intent(in), dimension(nx) :: bcoef b-spline coefficient array integer(kind=ip), intent(in) :: nx length of coefficient array integer(kind=ip), intent(in) :: kx order of b-spline, kx >= 1 integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: f integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(inout), dimension(3_ip*kx) :: w0 work array for dbfqad public pure subroutine db2ink (x, nx, y, ny, fcn, kx, ky, iknot, tx, ty, bcoef, iflag) Determines the parameters of a function that interpolates\n the two-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db2val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: nx Number of abcissae real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. integer(kind=ip), intent(in) :: ny Number of abcissae real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:) :: bcoef (nx,ny) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db2val (xval, yval, idx, idy, tx, ty, nx, ny, kx, ky, bcoef, f, iflag, inbvx, inbvy, iloy, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db2ink or one of its\n derivatives at the point ( xval , yval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise\npolynomial in the direction.\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db2ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db2ink ) real(kind=wp), intent(in), dimension(nx,ny) :: bcoef the b-spline coefficients computed by db2ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set to 1\nthe first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db3ink (x, nx, y, ny, z, nz, fcn, kx, ky, kz, iknot, tx, ty, tz, bcoef, iflag) Determines the parameters of a function that interpolates\n the three-dimensional gridded data The interpolating function and\n its derivatives may subsequently be evaluated by the function db3val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should\ncontain the function value at the point ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:) :: bcoef (nx,ny,nz) matrix of coefficients of the b-spline interpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db3val (xval, yval, zval, idx, idy, idz, tx, ty, tz, nx, ny, nz, kx, ky, kz, bcoef, f, iflag, inbvx, inbvy, inbvz, iloy, iloz, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db3ink or one of its\n derivatives at the point ( xval , yval , zval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db3ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db3ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db3ink ) real(kind=wp), intent(in), dimension(nx,ny,nz) :: bcoef the b-spline coefficients computed by db3ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be\nset to 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz) :: w2 work array real(kind=wp), intent(inout), dimension(kz) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db4ink (x, nx, y, ny, z, nz, q, nq, fcn, kx, ky, kz, kq, iknot, tx, ty, tz, tq, bcoef, iflag) Determines the parameters of a function that interpolates\n the four-dimensional gridded data The interpolating function and its derivatives may\n subsequently be evaluated by the function db4val . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,q) should contain the function value at the\n point ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the x direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the y direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the z direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the q direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:,:) :: bcoef (nx,ny,nz,nq) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db4val (xval, yval, zval, qval, idx, idy, idz, idq, tx, ty, tz, tq, nx, ny, nz, nq, kx, ky, kz, kq, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, iloy, iloz, iloq, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db4ink or one of its\n derivatives at the point ( xval , yval , zval , qval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction. (same as in last call to db4ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db4ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db4ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq) :: bcoef the b-spline coefficients computed by db4ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq) :: w3 work array real(kind=wp), intent(inout), dimension(kz,kq) :: w2 work array real(kind=wp), intent(inout), dimension(kq) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db5ink (x, nx, y, ny, z, nz, q, nq, r, nr, fcn, kx, ky, kz, kq, kr, iknot, tx, ty, tz, tq, tr, bcoef, iflag) Determines the parameters of a function that interpolates\n the five-dimensional gridded data: Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. must be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,q,r) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( ).\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the spline\ninterpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr) matrix of coefficients of the b-spline\ninterpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db5val (xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, tx, ty, tz, tq, tr, nx, ny, nz, nq, nr, kx, ky, kz, kq, kr, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, iloy, iloz, iloq, ilor, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db5ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db5ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db5ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr) :: bcoef the b-spline coefficients computed by db5ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr) :: w4 work array real(kind=wp), intent(inout), dimension(kz,kq,kr) :: w3 work array real(kind=wp), intent(inout), dimension(kq,kr) :: w2 work array real(kind=wp), intent(inout), dimension(kr) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) public pure subroutine db6ink (x, nx, y, ny, z, nz, q, nq, r, nr, s, ns, fcn, kx, ky, kz, kq, kr, ks, iknot, tx, ty, tz, tq, tr, ts, bcoef, iflag) Determines the parameters of a function that interpolates\n the six-dimensional gridded data: Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nx number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ny number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nz number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nq number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: nr number of abcissae ( ) real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae.\nmust be strictly increasing. integer(kind=ip), intent(in) :: ns number of abcissae ( ) real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to\ninterpolate. fcn(i,j,k,q,r,s) should contain the\nfunction value at the point\n( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks the order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: iknot knot sequence flag: Read more… real(kind=wp), intent(inout), dimension(:) :: tx The (nx+kx) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ty The (ny+ky) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tz The (nz+kz) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tq The (nq+kq) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: tr The (nr+kr) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(inout), dimension(:) :: ts The (ns+ks) knots in the direction for the\nspline interpolant. Read more… real(kind=wp), intent(out), dimension(:,:,:,:,:,:) :: bcoef (nx,ny,nz,nq,nr,ns) matrix of coefficients of the\nb-spline interpolant. integer(kind=ip), intent(out) :: iflag Read more… public pure subroutine db6val (xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, tx, ty, tz, tq, tr, ts, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, bcoef, f, iflag, inbvx, inbvy, inbvz, inbvq, inbvr, inbvs, iloy, iloz, iloq, ilor, ilos, w5, w4, w3, w2, w1, w0, extrap) Evaluates the tensor product piecewise polynomial\n interpolant constructed by the routine db6ink or one of its\n derivatives at the point ( xval , yval , zval , qval , rval , sval ). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(in), dimension(nx+kx) :: tx sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ny+ky) :: ty sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nz+kz) :: tz sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nq+kq) :: tq sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nr+kr) :: tr sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(ns+ks) :: ts sequence of knots defining the piecewise polynomial\nin the direction.\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nx the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ny the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nz the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nq the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: nr the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ns the number of interpolation points in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kx order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ky order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kz order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kq order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: kr order of polynomial pieces in .\n(same as in last call to db6ink ) integer(kind=ip), intent(in) :: ks order of polynomial pieces in .\n(same as in last call to db6ink ) real(kind=wp), intent(in), dimension(nx,ny,nz,nq,nr,ns) :: bcoef the b-spline coefficients computed by db6ink . real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag: Read more… integer(kind=ip), intent(inout) :: inbvx initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvr initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: inbvs initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloy initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloz initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: iloq initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilor initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. integer(kind=ip), intent(inout) :: ilos initialization parameter which must be set\nto 1 the first time this routine is called,\nand must not be changed by the user. real(kind=wp), intent(inout), dimension(ky,kz,kq,kr,ks) :: w5 work array real(kind=wp), intent(inout), dimension(kz,kq,kr,ks) :: w4 work array real(kind=wp), intent(inout), dimension(kq,kr,ks) :: w3 work array real(kind=wp), intent(inout), dimension(kr,ks) :: w2 work array real(kind=wp), intent(inout), dimension(ks) :: w1 work array real(kind=wp), intent(inout), dimension(3_ip*max(kx,ky,kz,kq,kr,ks)) :: w0 work array logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine check_inputs (iknot, iflag, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, x, y, z, q, r, s, tx, ty, tz, tq, tr, ts, f1, f2, f3, f4, f5, f6, bcoef1, bcoef2, bcoef3, bcoef4, bcoef5, bcoef6, alt, status_ok) Check the validity of the inputs to the db*ink routines.\n Prints warning message if there is an error,\n and also sets iflag and status_ok. Read more… Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: iknot = 0 if the INK routine is computing the knots. integer(kind=ip), intent(out) :: iflag integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: x real(kind=wp), intent(in), optional, dimension(:) :: y real(kind=wp), intent(in), optional, dimension(:) :: z real(kind=wp), intent(in), optional, dimension(:) :: q real(kind=wp), intent(in), optional, dimension(:) :: r real(kind=wp), intent(in), optional, dimension(:) :: s real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts real(kind=wp), intent(in), optional, dimension(:) :: f1 real(kind=wp), intent(in), optional, dimension(:,:) :: f2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: f3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: f4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: f5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: f6 real(kind=wp), intent(in), optional, dimension(:) :: bcoef1 real(kind=wp), intent(in), optional, dimension(:,:) :: bcoef2 real(kind=wp), intent(in), optional, dimension(:,:,:) :: bcoef3 real(kind=wp), intent(in), optional, dimension(:,:,:,:) :: bcoef4 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:) :: bcoef5 real(kind=wp), intent(in), optional, dimension(:,:,:,:,:,:) :: bcoef6 logical, intent(in), optional :: alt using the alt routine where 1st or\n2nd deriv is fixed at endpoints\n[default is False] logical, intent(out) :: status_ok private pure subroutine dbknot (x, n, k, t) dbknot chooses a knot sequence for interpolation of order k at the\n data points x(i), i=1,..,n. the n+k knots are placed in the array\n t. k knots are placed at each endpoint and not-a-knot end\n conditions are used. the remaining knots are placed at data points\n if n is even and between data points if n is odd. the rightmost\n knot is shifted slightly to the right to insure proper interpolation\n at x(n) (see page 350 of the reference). Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(:) :: t private pure subroutine dbtpcf (x, n, fcn, ldf, nf, t, k, bcoef, work, iflag) dbtpcf computes b-spline interpolation coefficients for nf sets\n of data stored in the columns of the array fcn. the b-spline\n coefficients are stored in the rows of bcoef however.\n each interpolation is based on the n abcissa stored in the\n array x, and the n+k knots stored in the array t. the order\n of each interpolation is k. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x integer(kind=ip), intent(in) :: n dimension of x real(kind=wp), intent(in), dimension(ldf,nf) :: fcn integer(kind=ip), intent(in) :: ldf integer(kind=ip), intent(in) :: nf real(kind=wp), intent(in), dimension(:) :: t integer(kind=ip), intent(in) :: k real(kind=wp), intent(out), dimension(nf,n) :: bcoef real(kind=wp), intent(out), dimension(*) :: work work array of size >= 2*k*(n+1) integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine dbintk (x, y, t, n, k, bcoef, q, work, iflag) dbintk produces the b-spline coefficients, bcoef, of the\n b-spline of order k with knots t(i), i=1,...,n+k, which\n takes on the value y(i) at x(i), i=1,...,n. the spline or\n any of its derivatives can be evaluated by calls to dbvalu . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(n) :: x vector of length n containing data point abscissa\nin strictly increasing order. real(kind=wp), intent(in), dimension(n) :: y corresponding vector of length n containing data\npoint ordinates. real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k\nsince t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) Read more… integer(kind=ip), intent(in) :: n number of data points, n >= k integer(kind=ip), intent(in) :: k order of the spline, k >= 1 real(kind=wp), intent(out), dimension(n) :: bcoef a vector of length n containing the b-spline coefficients real(kind=wp), intent(out), dimension(*) :: q a work vector of length (2 k-1) n, containing\nthe triangular factorization of the coefficient\nmatrix of the linear system being solved. the\ncoefficients for the interpolant of an\nadditional data set (x(i),yy(i)), i=1,...,n\nwith the same abscissa can be obtained by loading\nyy into bcoef and then executing\ncall dbnslv(q,2k-1,n,k-1,k-1,bcoef) real(kind=wp), intent(out), dimension(*) :: work work vector of length 2*k integer(kind=ip), intent(out) :: iflag Read more… private pure subroutine dbnfac (w, nroww, nrow, nbandl, nbandu, iflag) Returns in w the LU-factorization (without pivoting) of the banded\n matrix a of order nrow with (nbandl + 1 + nbandu) bands or diagonals\n in the work array w . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout), dimension(nroww,nrow) :: w work array. See header for details. integer(kind=ip), intent(in) :: nroww row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer(kind=ip), intent(in) :: nrow matrix order integer(kind=ip), intent(in) :: nbandl number of bands of a below the main diagonal integer(kind=ip), intent(in) :: nbandu number of bands of a above the main diagonal integer(kind=ip), intent(out) :: iflag indicating success(=1) or failure (=2) private pure subroutine dbnslv (w, nroww, nrow, nbandl, nbandu, b) Companion routine to dbnfac . it returns the solution x of the\n linear system a*x = b in place of b, given the lu-factorization\n for a in the work array w from dbnfac. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(nroww,nrow) :: w describes the lu-factorization of a banded matrix a of\norder nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nroww describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nrow describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandl describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . integer(kind=ip), intent(in) :: nbandu describes the lu-factorization of a banded matrix a of order nrow as constructed in dbnfac . real(kind=wp), intent(inout), dimension(nrow) :: b Read more… private pure subroutine dbspvn (t, jhigh, k, index, x, ileft, vnikx, work, iwork, iflag) Calculates the value of all (possibly) nonzero basis\n functions at x of order max(jhigh,(j+1)*(index-1)), where t(k)\n <= x <= t(n+1) and j=iwork is set inside the routine on\n the first call when index=1. ileft is such that t(ileft) <=\n x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag)\n produces the proper ileft. dbspvn calculates using the basic\n algorithm needed in dbspvd. if only basis functions are\n desired, setting jhigh=k and index=1 can be faster than\n calling dbspvd, but extra coding is required for derivatives\n (index=2) and dbspvd is set up for this purpose. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(*) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities- k dimension t(ileft+jhigh) integer(kind=ip), intent(in) :: jhigh order of b-spline, 1 <= jhigh <= k integer(kind=ip), intent(in) :: k highest possible order integer(kind=ip), intent(in) :: index index = 1 gives basis functions of order jhigh = 2 denotes previous entry with work , iwork values saved for subsequent calls to\n dbspvn. real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) real(kind=wp), intent(out), dimension(k) :: vnikx vector of length k for spline values. real(kind=wp), intent(inout), dimension(*) :: work a work vector of length 2*k integer(kind=ip), intent(inout) :: iwork a work parameter. both work and iwork contain\ninformation necessary to continue for index = 2 .\nwhen index = 1 exclusively, these are scratch\nvariables and can be used for other purposes. integer(kind=ip), intent(out) :: iflag Read more… private pure subroutine dbvalu (t, a, n, k, ideriv, x, inbv, work, iflag, val, extrap) Evaluates the b-representation ( t , a , n , k ) of a b-spline\n at x for the function value on ideriv=0 or any of its\n derivatives on ideriv=1,2,...,k-1 . right limiting values\n (right derivatives) are returned except at the right end\n point x=t(n+1) where left limiting values are computed. the\n spline is defined on t(k) x t(n+1) .\n dbvalu returns a fatal error message when x is outside of this\n interval. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k real(kind=wp), intent(in), dimension(n) :: a b-spline coefficient vector of length n integer(kind=ip), intent(in) :: n number of b-spline coefficients.\n(sum of knot multiplicities- k ) integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: ideriv order of the derivative, 0 <= ideriv <= k-1 . ideriv = 0 returns the b-spline value real(kind=wp), intent(in) :: x argument, t(k) <= x <= t(n+1) integer(kind=ip), intent(inout) :: inbv an initialization parameter which must be set\nto 1 the first time dbvalu is called. inbv contains information for efficient processing\nafter the initial call and inbv must not\nbe changed by the user. distinct splines require\ndistinct inbv parameters. real(kind=wp), intent(inout), dimension(:) :: work work vector of length at least 3*k integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(out) :: val the interpolated value logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine dintrv (xt, lxt, xx, ilo, ileft, mflag, extrap) Computes the largest integer ileft in 1 ileft lxt such that xt(ileft) x where xt(*) is a subdivision of\n the x interval.\n precisely, Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: xt a knot or break point vector of length lxt integer(kind=ip), intent(in) :: lxt length of the xt vector real(kind=wp), intent(in) :: xx argument integer(kind=ip), intent(inout) :: ilo an initialization parameter which must be set\nto 1 the first time the spline array xt is\nprocessed by dintrv. ilo contains information for\nefficient processing after the initial call and ilo must not be changed by the user. distinct splines\nrequire distinct ilo parameters. integer(kind=ip), intent(out) :: ileft largest integer satisfying xt(ileft) x integer(kind=ip), intent(out) :: mflag signals when x lies out of bounds logical, intent(in), optional :: extrap if extrapolation is allowed\n(if not present, default is False) private pure subroutine dbint4 (x, y, ndata, ibcl, ibcr, fbcl, fbcr, kntopt, tleft, tright, t, bcoef, n, k, w, iflag) DBINT4 computes the B representation ( t , bcoef , n , k ) of a\n cubic spline ( k=4 ) which interpolates data ( x(i) , y(i) ), i=1,ndata . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x x vector of abscissae of length ndata , distinct\nand in increasing order real(kind=wp), intent(in), dimension(:) :: y y vector of ordinates of length ndata integer(kind=ip), intent(in) :: ndata number of data points, ndata >= 2 integer(kind=ip), intent(in) :: ibcl selection parameter for left boundary condition: Read more… integer(kind=ip), intent(in) :: ibcr selection parameter for right boundary condition: Read more… real(kind=wp), intent(in) :: fbcl left boundary values governed by ibcl real(kind=wp), intent(in) :: fbcr right boundary values governed by ibcr integer(kind=ip), intent(in) :: kntopt knot selection parameter: Read more… real(kind=wp), intent(in), dimension(3) :: tleft when kntopt = 3 : t(1:3) in increasing\norder to be supplied by the user. real(kind=wp), intent(in), dimension(3) :: tright when kntopt = 3 : t(n+2:n+4) in increasing\norder to be supplied by the user. real(kind=wp), intent(out), dimension(:) :: t knot array of length n+4 real(kind=wp), intent(out), dimension(:) :: bcoef b spline coefficient array of length n integer(kind=ip), intent(out) :: n number of coefficients, n=ndata+2 integer(kind=ip), intent(out) :: k order of spline, k=4 real(kind=wp), intent(inout), dimension(5,ndata+2) :: w work array integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine dbspvd (t, k, nderiv, x, ileft, ldvnik, vnikx, work, iflag) DBSPVD calculates the value and all derivatives of order\n less than nderiv of all basis functions which do not\n (possibly) vanish at x . ileft is input such that t(ileft) <= x < t(ileft+1) . A call to dintrv ( t , n+1 , x , ilo , ileft , mflag ) will produce the proper ileft . The output of\n dbspvd is a matrix vnikx(i,j) of dimension at least (k,nderiv) whose columns contain the k nonzero basis functions and\n their nderiv-1 right derivatives at x , i=1,k, j=1,nderiv .\n These basis functions have indices ileft-k+i , i=1,k,\n k <= ileft <= n . The nonzero part of the i -th basis\n function lies in (t(i),t(i+k)), i=1,n) . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot vector of length n+k , where n = number of b-spline basis functions n = sum of knot multiplicities-k integer(kind=ip), intent(in) :: k order of the b-spline, k >= 1 integer(kind=ip), intent(in) :: nderiv number of derivatives = nderiv-1 , 1 <= nderiv <= k real(kind=wp), intent(in) :: x argument of basis functions, t(k) <= x <= t(n+1) integer(kind=ip), intent(in) :: ileft largest integer such that t(ileft) <= x < t(ileft+1) integer(kind=ip), intent(in) :: ldvnik leading dimension of matrix vnikx real(kind=wp), intent(out), dimension(ldvnik,nderiv) :: vnikx matrix of dimension at least (k,nderiv) containing the nonzero basis functions\nat x and their derivatives columnwise. real(kind=wp), intent(out), dimension(*) :: work a work vector of length (k+1)*(k+2)/2 integer(kind=ip), intent(out) :: iflag status flag: Read more… private pure subroutine dbsqad (t, bcoef, n, k, x1, x2, bquad, work, iflag) DBSQAD computes the integral on (x1,x2) of a k -th order\n b-spline using the b-representation (t,bcoef,n,k) . orders k as high as 20 are permitted by applying a 2, 6, or 10\n point gauss formula on subintervals of (x1,x2) which are\n formed by included (distinct) knots. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: t knot array of length n+k real(kind=wp), intent(in), dimension(:) :: bcoef b-spline coefficient array of length n integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, 1 <= k <= 20 real(kind=wp), intent(in) :: x1 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 end point of quadrature interval\nin t(k) <= x <= t(n+1) real(kind=wp), intent(out) :: bquad integral of the b-spline over ( x1 , x2 ) real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k integer(kind=ip), intent(out) :: iflag status flag: Read more… private subroutine dbfqad (f, t, bcoef, n, k, id, x1, x2, tol, quad, iflag, work) dbfqad computes the integral on (x1,x2) of a product of a\n function f and the id -th derivative of a k -th order b-spline,\n using the b-representation (t,bcoef,n,k) . (x1,x2) must be a\n subinterval of t(k) <= x <= t(n+1) . an integration routine, dbsgq8 (a modification of gaus8 ), integrates the product\n on subintervals of (x1,x2) formed by included (distinct) knots Read more… Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: f external function of one argument for the\nintegrand bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work) real(kind=wp), intent(in), dimension(n+k) :: t knot array real(kind=wp), intent(in), dimension(n) :: bcoef coefficient array integer(kind=ip), intent(in) :: n length of coefficient array integer(kind=ip), intent(in) :: k order of b-spline, k >= 1 integer(kind=ip), intent(in) :: id order of the spline derivative, 0 <= id <= k-1 id=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: x2 right point of quadrature interval in t(k) <= x <= t(n+1) real(kind=wp), intent(in) :: tol desired accuracy for the quadrature, suggest 10*dtol < tol <= 0.1 where dtol is the maximum\nof 1.0e-300 and real(wp) unit roundoff for\nthe machine real(kind=wp), intent(out) :: quad integral of bf(x) on (x1,x2) integer(kind=ip), intent(out) :: iflag status flag: Read more… real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k private subroutine dbsgq8 (fun, xt, bc, n, kk, id, a, b, inbv, err, ans, iflag, work) DBSGQ8, a modification of gaus8 ,\n integrates the product of fun(x) by the id -th derivative of a spline dbvalu between limits a and b using an adaptive 8-point Legendre-Gauss\n algorithm. Read more… Arguments Type Intent Optional Attributes Name procedure( b1fqad_func ) :: fun name of external function of one\nargument which multiplies dbvalu . real(kind=wp), intent(in), dimension(:) :: xt knot array for dbvalu real(kind=wp), intent(in), dimension(n) :: bc b-coefficient array for dbvalu integer(kind=ip), intent(in) :: n number of b-coefficients for dbvalu integer(kind=ip), intent(in) :: kk order of the spline, kk>=1 integer(kind=ip), intent(in) :: id Order of the spline derivative, 0<=id<=kk-1 real(kind=wp), intent(in) :: a lower limit of integral real(kind=wp), intent(in) :: b upper limit of integral (may be less than a ) integer(kind=ip), intent(inout) :: inbv initialization parameter for dbvalu real(kind=wp), intent(inout) :: err IN: is a requested pseudorelative error\ntolerance. normally pick a value of abs(err)<1e-3 . ans will normally\nhave no more error than abs(err) times\nthe integral of the absolute value of fun(x)*[[dbvalu]]() . Read more… real(kind=wp), intent(out) :: ans computed value of integral integer(kind=ip), intent(out) :: iflag a status code: Read more… real(kind=wp), intent(inout), dimension(:) :: work work vector of length 3*k for dbvalu","tags":"","loc":"module/bspline_sub_module.html"},{"title":"bspline_blas_module – bspline-fortran","text":"BLAS procedures, which can be use used if not linking with a BLAS library,\n if one is not available, or if a real kind /= real64 is required. The original code has been slightly modernized. Notes reference blas level1 routines reference blas is a software package provided by univ . of tennessee , univ . of california berkeley , univ . of colorado denver and nag ltd . See also [BLAS Sourcecode](https: Uses bspline_kinds_module module~~bspline_blas_module~~UsesGraph module~bspline_blas_module bspline_blas_module module~bspline_kinds_module bspline_kinds_module module~bspline_blas_module->module~bspline_kinds_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_blas_module~~UsedByGraph module~bspline_blas_module bspline_blas_module module~bspline_defc_module bspline_defc_module module~bspline_defc_module->module~bspline_blas_module module~bspline_module bspline_module module~bspline_module->module~bspline_defc_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Functions public function ddot (n, dx, incx, dy, incy) ddot forms the dot product of two vectors.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy Return Value real(kind=wp) public function dnrm2 (n, x, incx) returns the euclidean norm of a vector Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: x (*) integer(kind=ip) :: incx Return Value real(kind=wp) public function dasum (n, dx, incx) dasum takes the sum of the absolute values. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value real(kind=wp) public function idamax (n, dx, incx) idamax finds the index of the first element having maximum absolute value. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx Return Value integer Subroutines public subroutine daxpy (n, da, dx, incx, dy, incy) DAXPY constant times a vector plus a vector.\nuses unrolled loops for increments equal to one. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy public subroutine dcopy (n, dx, incx, dy, incy) DCOPY copies a vector, x, to a vector, y.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy public subroutine dscal (n, da, dx, incx) DSCAL scales a vector by a constant.\nuses unrolled loops for increment equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: da real(kind=wp) :: dx (*) integer(kind=ip) :: incx public subroutine dswap (n, dx, incx, dy, incy) DSWAP interchanges two vectors.\nuses unrolled loops for increments equal to 1. Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy public subroutine drotm (n, dx, incx, dy, incy, dparam) apply the modified givens transformation, H, to the 2 by n matrix Arguments Type Intent Optional Attributes Name integer(kind=ip) :: n real(kind=wp) :: dx (*) integer(kind=ip) :: incx real(kind=wp) :: dy (*) integer(kind=ip) :: incy real(kind=wp) :: dparam (5) public subroutine drotmg (dd1, dd2, dx1, dy1, dparam) construct the modified givens transformation matrix H Arguments Type Intent Optional Attributes Name real(kind=wp) :: dd1 real(kind=wp) :: dd2 real(kind=wp) :: dx1 real(kind=wp) :: dy1 real(kind=wp) :: dparam (5)","tags":"","loc":"module/bspline_blas_module.html"},{"title":"bspline_defc_module – bspline-fortran","text":"defc and dfc procedures and support routines from [SLATEC](https:\n For fitting B-splines polynomials to discrete 1D data. References For a description of the B-splines and usage instructions to\n evaluate them, see: C. W. de Boor, Package for Calculating with B-Splines.\n SIAM J. Numer. Anal., p. 441, (June, 1977). For further discussion of (constrained) curve fitting using\n B-splines, see reference 2. R. J. Hanson, Constrained least squares curve fitting\n to discrete data using B-splines, a users guide,\n Report SAND78-1291, Sandia Laboratories, December\n 1978. History Dec 2022 (Jacob Williams) : Cleanup and modernization of the SLATEC routines. Note This module does not support the user-defined ip integer kind.\n It only uses the default integer kind. Todo add iflag outputs to be consistent with the rest of the library. Uses bspline_kinds_module bspline_blas_module module~~bspline_defc_module~~UsesGraph module~bspline_defc_module bspline_defc_module module~bspline_blas_module bspline_blas_module module~bspline_defc_module->module~bspline_blas_module module~bspline_kinds_module bspline_kinds_module module~bspline_defc_module->module~bspline_kinds_module module~bspline_blas_module->module~bspline_kinds_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_defc_module~~UsedByGraph module~bspline_defc_module bspline_defc_module module~bspline_module bspline_module module~bspline_module->module~bspline_defc_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial real(kind=wp), private, parameter :: drelpr = epsilon(1.0_wp) machine precision ( d1mach(4) ) Functions private function dwnlt2 (me, mend, ir, factor, tau, scale, wic) To test independence of incoming column. Read more… Arguments Type Intent Optional Attributes Name integer :: me integer :: mend integer :: ir real(kind=wp) :: factor real(kind=wp) :: tau real(kind=wp) :: scale (*) real(kind=wp) :: wic (*) Return Value logical public function dcv (xval, ndata, nconst, nord, nbkpt, bkpt, w) dcv is a companion function subprogram for dfc . The\n documentation for dfc has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: xval The point where the variance is desired integer, intent(in) :: ndata The number of discrete (X,Y) pairs for which dfc calculated a piece-wise polynomial curve. integer, intent(in) :: nconst The number of conditions that constrained the B-spline in dfc . integer, intent(in) :: nord The order of the B-spline used in dfc .\nThe value of NORD must satisfy 1 < NORD < 20 . Read more… integer, intent(in) :: nbkpt The number of knots in the array BKPT( ).\nThe value of NBKPT must satisfy NBKPT .GE. 2 NORD. real(kind=wp), intent(in) :: bkpt (*) The array of knots. Normally the problem\ndata interval will be included between the limits\nBKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end\nknots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT,\nare required by dfc to compute the functions used to\nfit the data. real(kind=wp) :: w (*) Real work array as used in dfc . See dfc for the required length of W( ). The contents of W( )\nmust not be modified by the user if the variance function\nis desired. Return Value real(kind=wp) Subroutines public subroutine defc (Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkpt, Mdein, Mdeout, Coeff, Lw, w) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: Ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in), dimension(ndata) :: Xdata X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in), dimension(ndata) :: Ydata Y data array. real(kind=wp), intent(in), dimension(ndata) :: Sddata Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: Nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(:) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: Mdein An integer flag, with one of two possible\nvalues (1 or 2), that directs the subprogram\naction with regard to new data points provided\nby the user: Read more… integer, intent(out) :: Mdeout An output flag that indicates the status\nof the curve fit: Read more… real(kind=wp), intent(out) :: Coeff (*) If the output value of MDEOUT=1 , this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD parameters are the B-spline coefficients.\nFor MDEOUT=2 , not enough data was processed to\nuniquely determine the B-spline coefficients.\nIn this case, and also when MDEOUT=-1 , all\nvalues of COEFF(*) are set to zero. Read more… integer, intent(in) :: Lw The amount of working storage actually\n allocated for the working array W(*) .\n This quantity is compared with the\n actual amount of storage needed in DEFC .\n Insufficient storage allocated for W(*) is\n an error. This feature was included in DEFC because misreading the storage formula\n for W(*) might very well lead to subtle\n and hard-to-find programming bugs. Read more… real(kind=wp) :: w (*) Working Array.\nIts length is specified as an input parameter\nin LW as noted above. The contents of W(*) must not be modified by the user between calls\nto DEFC with values of MDEIN=1,2,2,... .\nThe first (NBKPT-NORD+3)*(NORD+1) entries of W(*) are acceptable as direct input to DFC for an \"old problem\" only when MDEOUT=1 or 2 . private subroutine defcmn (Ndata, Xdata, Ydata, Sddata, Nord, Nbkpt, Bkptin, Mdein, Mdeout, Coeff, Bf, Xtemp, Ptemp, Bkpt, g, Mdg, w, Mdw, Lw) This is a companion subprogram to DEFC .\n This subprogram does weighted least squares fitting of data by\n B-spline curves.\n The documentation for DEFC has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name integer :: Ndata real(kind=wp) :: Xdata (*) real(kind=wp) :: Ydata (*) real(kind=wp) :: Sddata (*) integer :: Nord integer :: Nbkpt real(kind=wp) :: Bkptin (*) integer :: Mdein integer :: Mdeout real(kind=wp) :: Coeff (*) real(kind=wp) :: Bf (Nord,*) real(kind=wp) :: Xtemp (*) real(kind=wp) :: Ptemp (*) real(kind=wp) :: Bkpt (*) real(kind=wp) :: g (Mdg,*) integer :: Mdg real(kind=wp) :: w (Mdw,*) integer :: Mdw integer :: Lw private subroutine dbndac (g, Mdg, Nb, Ip, Ir, Mt, Jt) These subroutines solve the least squares problem Ax = b for\n banded matrices A using sequential accumulation of rows of the\n data matrix. Exactly one right-hand side vector is permitted. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: g (Mdg,*) G(MDG,NB+1) Read more… integer, intent(in) :: Mdg The number of rows in the working array G(*,*) . The value of MDG should be >= MU .\nThe value of MU is defined in the abstract\nof these subprograms. integer, intent(in) :: Nb The bandwidth of the data matrix A . integer, intent(inout) :: Ip Input Set by the user to the value 1 before the\nfirst call to DBNDAC . Its subsequent value\nis controlled by DBNDAC to set up for the\nnext call to DBNDAC . Read more… integer, intent(inout) :: Ir Input Index of the row of G(*,*) where the user is\nto place the new block of data (C F) . Set by\nthe user to the value 1 before the first call\nto DBNDAC . Its subsequent value is controlled\nby DBNDAC . A value of IR > MDG is considered\nan error. Read more… integer, intent(in) :: Mt Set by the user to indicate the\nnumber of new rows of data in the block integer, intent(in) :: Jt Set by the user to indicate\nthe index of the first nonzero column in that\nset of rows (E F) = (0 C 0 F) being processed. private subroutine dbndsl (Mode, g, Mdg, Nb, Ip, Ir, x, n, Rnorm) These subroutines solve the least squares problem Ax = b for\n banded matrices A using sequential accumulation of rows of the\n data matrix. Exactly one right-hand side vector is permitted. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: Mode Set by the user to one of the values 1, 2, or\n3. These values respectively indicate that\nthe solution of AX = B , YR = H or RZ = W is\nrequired. real(kind=wp), intent(in) :: g (Mdg,*) G(MDG,NB+1) Read more… integer, intent(in) :: Mdg The number of rows in the working array G(*,*) . The value of MDG should be >= MU .\nThe value of MU is defined in the abstract\nof these subprograms. Read more… integer, intent(in) :: Nb This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ip This argument has the same meaning and\ncontents as following the last call to DBNDAC . integer, intent(in) :: Ir This argument has the same meaning and\ncontents as following the last call to DBNDAC . real(kind=wp), intent(inout) :: x (*) X(N) Read more… integer, intent(in) :: n The number of variables in the solution\nvector. If any of the N diagonal terms are\nzero the subroutine DBNDSL prints an\nappropriate message. This condition is\nconsidered an error. real(kind=wp), intent(out) :: Rnorm If MODE=1 , RNORM is the Euclidean length of the\nresidual vector AX-B . When MODE=2 or 3 RNORM`\nis set to zero. private subroutine dfspvn (t, Jhigh, Index, x, Ileft, Vnikx, j, deltam, deltap) Calculates the value of all possibly nonzero B-splines at X of\n order MAX(JHIGH,(J+1)(INDEX-1)) on T . Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in) :: t (*) integer, intent(in) :: Jhigh integer, intent(in) :: Index real(kind=wp), intent(in) :: x integer, intent(in) :: Ileft real(kind=wp) :: Vnikx (*) integer, intent(inout) :: j JW : added real(kind=wp), intent(inout), dimension(20) :: deltam JW : added real(kind=wp), intent(inout), dimension(20) :: deltap JW : added private subroutine dh12 (Mode, Lpivot, l1, m, u, Iue, Up, c, Ice, Icv, Ncv) Construction and/or application of a single\n Householder transformation. Q = I + U*(U**T)/B Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: Mode 1 or 2 to select algorithm H1 or H2 . integer, intent(in) :: Lpivot the index of the pivot element. integer, intent(in) :: l1 If L1 <= M the transformation will be constructed to\nzero elements indexed from L1 through M . If L1 > M the subroutine does an identity transformation. integer, intent(in) :: m see l1 real(kind=wp), intent(inout) :: u (Iue,*) On entry to H1 U() contains the pivot vector.\nOn exit from H1 U() and UP contain quantities defining the vector U of the\nHouseholder transformation. On entry to H2 U() and UP should contain quantities previously computed\nby H1. These will not be modified by H2. integer, intent(in) :: Iue the storage increment between elements of U . real(kind=wp), intent(inout) :: Up see u real(kind=wp), intent(inout) :: c (*) On entry to H1 or H2 C() contains a matrix which will be\nregarded as a set of vectors to which the Householder\ntransformation is to be applied. On exit C() contains the\nset of transformed vectors. integer, intent(in) :: Ice Storage increment between elements of vectors in C() . integer, intent(in) :: Icv Storage increment between vectors in C() . integer, intent(in) :: Ncv Number of vectors in C() to be transformed. If NCV <= 0 no operations will be done on C() . private subroutine dsort (n, Kflag, Dx, Dy) Sort an array and optionally make the same interchanges in\n an auxiliary array. The array may be sorted in increasing\n or decreasing order. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: n number of values in array DX to be sorted integer, intent(in) :: Kflag control parameter:\n * Kflag < 0 : sort DX in decreasing order and optionally carry DY along.\n * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real(kind=wp), intent(inout), dimension(*) :: Dx array of values to be sorted (usually abscissas) real(kind=wp), intent(inout), optional, dimension(*) :: Dy array to be (optionally) carried along private subroutine sort_ascending (n, dx, dy) Recursive quicksoft.\n Modified to also carry along a second array. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=wp), intent(inout), dimension(*) :: dx array of values to be sorted real(kind=wp), intent(inout), optional, dimension(*) :: dy array to be (optionally) carried along public subroutine dfc (ndata, xdata, ydata, sddata, nord, Nbkpt, Bkpt, nconst, xconst, yconst, nderiv, mode, coeff, w, iw) This subprogram fits a piecewise polynomial curve\n to discrete data. The piecewise polynomials are\n represented as B-splines.\n The fitting is done in a weighted least squares sense.\n Equality and inequality constraints can be imposed on the\n fitted curve. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: ndata number of points (size of xdata and ydata ).\nAny non-negative value of NDATA is allowed.\nA negative value of NDATA is an error. real(kind=wp), intent(in) :: xdata (*) X data array. No sorting of XDATA(*) is required. real(kind=wp), intent(in) :: ydata (*) Y data array. real(kind=wp), intent(in) :: sddata (*) Y value standard deviation or uncertainty.\nA zero value for any entry of SDDATA(*) will weight that data point as 1.\nOtherwise the weight of that data point is\nthe reciprocal of this entry. integer, intent(in) :: nord B-spline order.\n(The order of the spline is one more than the\ndegree of the piecewise polynomial defined on\neach interval. This is consistent with the\nB-spline package convention. For example, NORD=4 when we are using piecewise cubics.) NORD must be in the range 1 <= NORD <= 20 . integer, intent(in) :: Nbkpt The value of NBKPT must satisfy the condition NBKPT >= 2*NORD . real(kind=wp), intent(in), dimension(*) :: Bkpt NBKPT knots of the B-spline.\nNormally the\nproblem data interval will be included between\nthe limits BKPT(NORD) and BKPT(NBKPT-NORD+1) .\nThe additional end knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT , are\nrequired to compute the functions used to fit\nthe data. No sorting of BKPT(*) is required.\nInternal to DEFC the extreme end knots may\nbe reduced and increased respectively to\naccommodate any data values that are exterior\nto the given knot values. The contents of BKPT(*) is not changed. integer, intent(in) :: nconst The number of conditions that constrain the\nB-spline is NCONST. A constraint is specified\nby an (X,Y) pair in the arrays XCONST( ) and\nYCONST( ), and by the type of constraint and\nderivative value encoded in the array\nNDERIV(*). real(kind=wp), intent(in) :: xconst (*) X value of constraint.\nNo sorting of XCONST(*) is required. real(kind=wp), intent(in) :: yconst (*) Y value of constraint integer, intent(in) :: nderiv (*) The value of NDERIV(*) is\n determined as follows. Suppose the I-th\n constraint applies to the J-th derivative\n of the B-spline. (Any non-negative value of\n J < NORD is permitted. In particular the\n value J=0 refers to the B-spline itself.)\n For this I-th constraint, set Read more… integer, intent(inout) :: mode Input Read more… real(kind=wp), intent(out) :: coeff (*) If the output value of MODE=0 or 1, this array\ncontains the unknowns obtained from the least\nsquares fitting process. These N=NBKPT-NORD\nparameters are the B-spline coefficients.\nFor MODE=1, the equality constraints are\ncontradictory. To make the fitting process\nmore robust, the equality constraints are\nsatisfied in a least squares sense. In this\ncase the array COEFF( ) contains B-spline\ncoefficients for this extended concept of a\nsolution. If MODE=-1,2 or 3 on output, the\narray COEFF( ) is undefined. real(kind=wp) :: w (*) real work array of length IW(1) . The\n contents of W(*) must not be modified by the\n user if the variance function is desired. Read more… integer :: iw (*) integer work array of length IW(2) Read more… private subroutine dfcmn (ndata, xdata, ydata, sddata, nord, nbkpt, bkptin, nconst, xconst, yconst, nderiv, mode, coeff, bf, xtemp, ptemp, bkpt, g, mdg, w, mdw, work, iwork) This is a companion subprogram to DFC .\n The documentation for DFC has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name integer :: ndata real(kind=wp) :: xdata (*) real(kind=wp) :: ydata (*) real(kind=wp) :: sddata (*) integer :: nord integer :: nbkpt real(kind=wp) :: bkptin (*) integer :: nconst real(kind=wp) :: xconst (*) real(kind=wp) :: yconst (*) integer :: nderiv (*) integer :: mode real(kind=wp) :: coeff (*) real(kind=wp) :: bf (nord,*) real(kind=wp) :: xtemp (*) real(kind=wp) :: ptemp (*) real(kind=wp) :: bkpt (*) real(kind=wp) :: g (mdg,*) integer :: mdg real(kind=wp) :: w (mdw,*) integer :: mdw real(kind=wp) :: work (*) integer :: iwork (*) private subroutine dfspvd (t, k, x, ileft, vnikx, nderiv) Calculates value and derivs of all B-splines which do not vanish at X Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: t (*) integer :: k real(kind=wp) :: x integer :: ileft real(kind=wp) :: vnikx (k,*) integer :: nderiv private subroutine dhfti (a, mda, m, n, b, mdb, nb, tau, krank, rnorm, h, g, ip) Solve a least squares problem for banded matrices using\n sequential accumulation of rows of the data matrix.\n Exactly one right-hand side vector is permitted. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp), intent(inout) :: a (mda,*) A(MDA,N) .\nThe array A( , ) initially contains the M by N\nmatrix A of the least squares problem AX = B.\nThe first dimensioning parameter of the array\nA( , ) is MDA, which must satisfy MDA>=M\nEither M>=N or M0\nthe array B( ) must initially contain the M by\nNB matrix B of the least squares problem AX =\nB. If NB>=2 the array B( ) must be doubly\nsubscripted with first dimensioning parameter\nMDB>=MAX(M,N). If NB = 1 the array B( ) may\nbe either doubly or singly subscripted. In\nthe latter case the value of MDB is arbitrary\nbut it should be set to some valid integer\nvalue such as MDB = M. Read more… integer, intent(in) :: mdb actual leading dimension of b integer, intent(in) :: nb real(kind=wp), intent(in) :: tau Absolute tolerance parameter provided by user\nfor pseudorank determination. integer, intent(out) :: krank Set by the subroutine to indicate the\npseudorank of A. real(kind=wp), intent(out) :: rnorm (*) RNORM(NB) .\nOn return, RNORM(J) will contain the Euclidean\nnorm of the residual vector for the problem\ndefined by the J-th column vector of the array\nB( , ) for J = 1,...,NB. real(kind=wp) :: h (*) H(N) . Array of working space used by DHFTI.\nOn return, contains\nelements of the pre-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. real(kind=wp) :: g (*) G(N) . Array of working space used by DHFTI.\nOn return, contain\nelements of the post-multiplying\nHouseholder transformations used to compute\nthe minimum Euclidean length solution.\nnot generally required by the user. integer :: ip (*) IP(N) . Array of working space used by DHFTI.\nArray in which the subroutine records indices\ndescribing the permutation of column vectors.\nnot generally required by the user. private subroutine dlpdp (a, mda, m, n1, n2, prgopt, x, wnorm, mode, ws, is) Determine an N1-vector W, and\n an N2-vector Z\n which minimizes the Euclidean length of W\n subject to G W+H Z >= Y.\n This is the least projected distance problem, LPDP.\n The matrices G and H are of respective\n dimensions M by N1 and M by N2. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: a (mda,*) A(MDA,N+1) , where N=N1+N2 . integer, intent(in) :: mda integer :: m integer, intent(in) :: n1 integer, intent(in) :: n2 real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) X(N) , where N=N1+N2 . real(kind=wp) :: wnorm integer, intent(out) :: mode The value of MODE indicates the status of\nthe computation after returning to the user. Read more… real(kind=wp) :: ws (*) WS((M+2)*(N+7)) , where N=N1+N2 . This is a slight overestimate for WS(*). integer :: is (*) IS(M+N+1) , where N=N1+N2 . private subroutine dlsei (w, mdw, me, ma, mg, n, prgopt, x, rnorme, rnorml, mode, ws, ip) This subprogram solves a linearly constrained least squares\n problem with both equality and inequality constraints, and, if the\n user requests, obtains a covariance matrix of the solution\n parameters. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer, intent(in) :: mdw integer :: me integer :: ma integer :: mg integer :: n real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorme real(kind=wp) :: rnorml integer :: mode real(kind=wp) :: ws (*) integer :: ip (3) private subroutine dlsi (w, mdw, ma, mg, n, prgopt, x, rnorm, mode, ws, ip) This is a companion subprogram to DLSEI . The documentation for DLSEI has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) W(*,*) contains: Read more… integer, intent(in) :: mdw contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: ma contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: mg contain (resp) var. dimension of W(*,*) , and matrix dimensions. integer, intent(in) :: n contain (resp) var. dimension of W(*,*) , and matrix dimensions. real(kind=wp), intent(in) :: prgopt (*) Program option vector. real(kind=wp), intent(out) :: x (*) Solution vector(unless MODE=2) real(kind=wp), intent(out) :: rnorm length of AX-B. integer, intent(out) :: mode Read more… real(kind=wp) :: ws (*) Working storage of dimension K+N+(MG+2)*(N+7) ,\nwhere K=MAX(MA+MG,N) . integer :: ip (*) IP(MG+2*N+1) Integer working storage private subroutine dwnlit (w, mdw, m, n, l, ipivot, itype, h, scale, rnorm, idope, dope, done) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: m integer :: n integer :: l integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: rnorm integer :: idope (*) real(kind=wp) :: dope (*) logical :: done private subroutine dwnlsm (w, mdw, mme, ma, n, l, prgopt, x, rnorm, mode, ipivot, itype, wd, h, scale, z, temp, d) This is a companion subprogram to DWNNLS .\n The documentation for DWNNLS has complete usage instructions. Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: mme integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: ipivot (*) integer :: itype (*) real(kind=wp) :: wd (*) real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: z (*) real(kind=wp) :: temp (*) real(kind=wp) :: d (*) private subroutine dwnlt1 (i, lend, mend, ir, mdw, recalc, imax, hbar, h, scale, w) To update the column Sum Of Squares and find the pivot column.\n The column Sum of Squares Vector will be updated at each step.\n When numerically necessary, these values will be recomputed. Read more… Arguments Type Intent Optional Attributes Name integer :: i integer :: lend integer :: mend integer :: ir integer :: mdw logical :: recalc integer :: imax real(kind=wp) :: hbar real(kind=wp) :: h (*) real(kind=wp) :: scale (*) real(kind=wp) :: w (mdw,*) private subroutine dwnlt3 (i, imax, m, mdw, ipivot, h, w) Perform column interchange.\n Exchange elements of permuted index vector and perform column\n interchanges. Read more… Arguments Type Intent Optional Attributes Name integer, intent(in) :: i integer, intent(in) :: imax integer, intent(in) :: m integer, intent(in) :: mdw integer, intent(inout) :: ipivot (*) real(kind=wp), intent(inout) :: h (*) real(kind=wp), intent(inout) :: w (mdw,*) private subroutine dwnnls (w, mdw, me, ma, n, l, prgopt, x, rnorm, mode, iwork, work) This subprogram solves a linearly constrained least squares\n problem. Suppose there are given matrices E and A of\n respective dimensions ME by N and MA by N , and vectors F and B of respective lengths ME and MA . This subroutine\n solves the problem Read more… Arguments Type Intent Optional Attributes Name real(kind=wp) :: w (mdw,*) integer :: mdw integer :: me integer :: ma integer :: n integer :: l real(kind=wp) :: prgopt (*) real(kind=wp) :: x (*) real(kind=wp) :: rnorm integer :: mode integer :: iwork (*) real(kind=wp) :: work (*)","tags":"","loc":"module/bspline_defc_module.html"},{"title":"bspline_module – bspline-fortran","text":"Description Multidimensional (1D-6D) B-Spline interpolation of data on a regular grid.\n This module uses both the subroutine and object-oriented modules. Uses bspline_sub_module bspline_kinds_module bspline_defc_module bspline_oo_module module~~bspline_module~~UsesGraph module~bspline_module bspline_module module~bspline_defc_module bspline_defc_module module~bspline_module->module~bspline_defc_module module~bspline_kinds_module bspline_kinds_module module~bspline_module->module~bspline_kinds_module module~bspline_oo_module bspline_oo_module module~bspline_module->module~bspline_oo_module module~bspline_sub_module bspline_sub_module module~bspline_module->module~bspline_sub_module module~bspline_defc_module->module~bspline_kinds_module module~bspline_blas_module bspline_blas_module module~bspline_defc_module->module~bspline_blas_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env module~bspline_oo_module->module~bspline_kinds_module module~bspline_oo_module->module~bspline_sub_module module~bspline_oo_module->iso_fortran_env module~bspline_sub_module->module~bspline_kinds_module module~bspline_sub_module->iso_fortran_env module~bspline_blas_module->module~bspline_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses.","tags":"","loc":"module/bspline_module.html"},{"title":"bspline_kinds_module – bspline-fortran","text":"Description Numeric kind definitions for BSpline-Fortran. Uses iso_fortran_env module~~bspline_kinds_module~~UsesGraph module~bspline_kinds_module bspline_kinds_module iso_fortran_env iso_fortran_env module~bspline_kinds_module->iso_fortran_env Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_kinds_module~~UsedByGraph module~bspline_kinds_module bspline_kinds_module module~bspline_blas_module bspline_blas_module module~bspline_blas_module->module~bspline_kinds_module module~bspline_defc_module bspline_defc_module module~bspline_defc_module->module~bspline_kinds_module module~bspline_defc_module->module~bspline_blas_module module~bspline_module bspline_module module~bspline_module->module~bspline_kinds_module module~bspline_module->module~bspline_defc_module module~bspline_oo_module bspline_oo_module module~bspline_module->module~bspline_oo_module module~bspline_sub_module bspline_sub_module module~bspline_module->module~bspline_sub_module module~bspline_oo_module->module~bspline_kinds_module module~bspline_oo_module->module~bspline_sub_module module~bspline_sub_module->module~bspline_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, public, parameter :: wp = real64 Real working precision if not specified [8 bytes] integer, public, parameter :: ip = int32 Integer working precision if not specified [4 bytes]","tags":"","loc":"module/bspline_kinds_module.html"},{"title":"bspline_oo_module – bspline-fortran","text":"Object-oriented style wrappers to bspline_sub_module .\nThis module provides classes ( bspline_1d , bspline_2d , bspline_3d , bspline_4d , bspline_5d , and bspline_6d )\nwhich can be used instead of the main subroutine interface. Uses bspline_sub_module bspline_kinds_module iso_fortran_env module~~bspline_oo_module~~UsesGraph module~bspline_oo_module bspline_oo_module iso_fortran_env iso_fortran_env module~bspline_oo_module->iso_fortran_env module~bspline_kinds_module bspline_kinds_module module~bspline_oo_module->module~bspline_kinds_module module~bspline_sub_module bspline_sub_module module~bspline_oo_module->module~bspline_sub_module module~bspline_kinds_module->iso_fortran_env module~bspline_sub_module->iso_fortran_env module~bspline_sub_module->module~bspline_kinds_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Used by module~~bspline_oo_module~~UsedByGraph module~bspline_oo_module bspline_oo_module module~bspline_module bspline_module module~bspline_module->module~bspline_oo_module Help Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer(kind=ip), private, parameter :: int_size = storage_size(1_ip, kind=ip) size of a default integer [bits] integer(kind=ip), private, parameter :: logical_size = storage_size(.true., kind=ip) size of a default logical [bits] integer(kind=ip), private, parameter :: real_size = storage_size(1.0_wp, kind=ip) size of a real(wp) [bits] Interfaces public interface bspline_1d Constructor for bspline_1d private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) public interface bspline_2d Constructor for bspline_2d private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) public interface bspline_3d Constructor for bspline_3d private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) public interface bspline_4d Constructor for bspline_4d private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) public interface bspline_5d Constructor for bspline_5d private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) public interface bspline_6d Constructor for bspline_6d private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Abstract Interfaces abstract interface private pure function size_func(me) result(s) interface for size routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits abstract interface private pure subroutine destroy_func(me) interface for bspline destructor routines Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me Derived Types type, public :: bspline_class Base class for the b-spline types Components Type Visibility Attributes Name Initial integer(kind=ip), private :: inbvx = 1_ip internal variable used by dbvalu for efficient processing integer(kind=ip), private :: iflag = 1_ip saved iflag from the list routine call. logical, private :: initialized = .false. true if the class is initialized and ready to use logical, private :: extrap = .false. if true, then extrapolation is allowed during evaluation Type-Bound Procedures procedure, private, non_overridable :: destroy_base ../../ destructor for the abstract type procedure, private, non_overridable :: set_extrap_flag ../../ internal routine to set the extrap flag procedure( destroy_func ), public, deferred :: destroy ../../ destructor procedure( size_func ), public, deferred :: size_of ../../ size of the structure in bits procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. type, public, extends( bspline_class ) :: bspline_1d Class for 1d b-spline interpolation. Read more… Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db1val] work array of dimension 3*kx Constructor Constructor for bspline_1d private\n\n pure, elemental\n function bspline_1d_constructor_empty () It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . private\n\n pure\n function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Finalizations Procedures final :: finalize_1d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots procedure, private :: initialize_1d_auto_knots procedure, private :: initialize_1d_specify_knots procedure, public :: evaluate => evaluate_1d procedure, public :: destroy => destroy_1d procedure, public :: size_of => size_1d procedure, public :: integral => integral_1d procedure, public :: fintegral => fintegral_1d type, public, extends( bspline_class ) :: bspline_2d Class for 2d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:), allocatable :: work_val_1 [[db2val] work array of dimension ky real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db2val] work array of dimension 3_ip*max(kx,ky) Constructor Constructor for bspline_2d private\n\n elemental\n function bspline_2d_constructor_empty () It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . private\n\n pure\n function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Finalizations Procedures final :: finalize_2d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots procedure, private :: initialize_2d_auto_knots procedure, private :: initialize_2d_specify_knots procedure, public :: evaluate => evaluate_2d procedure, public :: destroy => destroy_2d procedure, public :: size_of => size_2d type, public, extends( bspline_class ) :: bspline_3d Class for 3d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:), allocatable :: work_val_1 [[db3val] work array of dimension ky,kz real(kind=wp), private, dimension(:), allocatable :: work_val_2 [[db3val] work array of dimension kz real(kind=wp), private, dimension(:), allocatable :: work_val_3 [[db3val] work array of dimension 3_ip*max(kx,ky,kz) Constructor Constructor for bspline_3d private\n\n elemental\n function bspline_3d_constructor_empty () It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . private\n\n pure\n function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Finalizations Procedures final :: finalize_3d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots procedure, private :: initialize_3d_auto_knots procedure, private :: initialize_3d_specify_knots procedure, public :: evaluate => evaluate_3d procedure, public :: destroy => destroy_3d procedure, public :: size_of => size_3d type, public, extends( bspline_class ) :: bspline_4d Class for 4d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_1 db4val work array of dimension ky,kz,kq real(kind=wp), private, dimension(:,:), allocatable :: work_val_2 db4val work array of dimension kz,kq real(kind=wp), private, dimension(:), allocatable :: work_val_3 db4val work array of dimension kq real(kind=wp), private, dimension(:), allocatable :: work_val_4 db4val work array of dimension 3_ip*max(kx,ky,kz,kq) Constructor Constructor for bspline_4d private\n\n elemental\n function bspline_4d_constructor_empty () It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . private\n\n pure\n function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Finalizations Procedures final :: finalize_4d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots procedure, private :: initialize_4d_auto_knots procedure, private :: initialize_4d_specify_knots procedure, public :: evaluate => evaluate_4d procedure, public :: destroy => destroy_4d procedure, public :: size_of => size_4d type, public, extends( bspline_class ) :: bspline_5d Class for 5d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_1 db5val work array of dimension ky,kz,kq,kr real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_2 db5val work array of dimension kz,kq,kr real(kind=wp), private, dimension(:,:), allocatable :: work_val_3 db5val work array of dimension kq,kr real(kind=wp), private, dimension(:), allocatable :: work_val_4 db5val work array of dimension kr real(kind=wp), private, dimension(:), allocatable :: work_val_5 db5val work array of dimension 3_ip*max(kx,ky,kz,kq,kr) Constructor Constructor for bspline_5d private\n\n elemental\n function bspline_5d_constructor_empty () It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . private\n\n pure\n function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Finalizations Procedures final :: finalize_5d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots procedure, private :: initialize_5d_auto_knots procedure, private :: initialize_5d_specify_knots procedure, public :: evaluate => evaluate_5d procedure, public :: destroy => destroy_5d procedure, public :: size_of => size_5d type, public, extends( bspline_class ) :: bspline_6d Class for 6d b-spline interpolation. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: nx = 0_ip Number of abcissae integer(kind=ip), private :: ny = 0_ip Number of abcissae integer(kind=ip), private :: nz = 0_ip Number of abcissae integer(kind=ip), private :: nq = 0_ip Number of abcissae integer(kind=ip), private :: nr = 0_ip Number of abcissae integer(kind=ip), private :: ns = 0_ip Number of abcissae integer(kind=ip), private :: kx = 0_ip The order of spline pieces in integer(kind=ip), private :: ky = 0_ip The order of spline pieces in integer(kind=ip), private :: kz = 0_ip The order of spline pieces in integer(kind=ip), private :: kq = 0_ip The order of spline pieces in integer(kind=ip), private :: kr = 0_ip The order of spline pieces in integer(kind=ip), private :: ks = 0_ip The order of spline pieces in real(kind=wp), private, dimension(:,:,:,:,:,:), allocatable :: bcoef array of coefficients of the b-spline interpolant real(kind=wp), private, dimension(:), allocatable :: tx The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ty The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tz The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tq The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: tr The knots in the direction for the spline interpolant real(kind=wp), private, dimension(:), allocatable :: ts The knots in the direction for the spline interpolant integer(kind=ip), private :: inbvy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvr = 1_ip internal variable used for efficient processing integer(kind=ip), private :: inbvs = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloy = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloz = 1_ip internal variable used for efficient processing integer(kind=ip), private :: iloq = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilor = 1_ip internal variable used for efficient processing integer(kind=ip), private :: ilos = 1_ip internal variable used for efficient processing real(kind=wp), private, dimension(:,:,:,:,:), allocatable :: work_val_1 db6val work array of dimension ky,kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:,:), allocatable :: work_val_2 db6val work array of dimension kz,kq,kr,ks real(kind=wp), private, dimension(:,:,:), allocatable :: work_val_3 db6val work array of dimension kq,kr,ks real(kind=wp), private, dimension(:,:), allocatable :: work_val_4 db6val work array of dimension kr,ks real(kind=wp), private, dimension(:), allocatable :: work_val_5 db6val work array of dimension ks real(kind=wp), private, dimension(:), allocatable :: work_val_6 db6val work array of dimension 3_ip*max(kx,ky,kz,kq,kr,ks) Constructor Constructor for bspline_6d private\n\n elemental\n function bspline_6d_constructor_empty () It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. private\n\n pure\n function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . private\n\n pure\n function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Finalizations Procedures final :: finalize_6d Type-Bound Procedures procedure, public, non_overridable :: status_ok ../../ returns true if the last iflag status code was =0 . procedure, public, non_overridable :: status_message => get_bspline_status_message ../../ retrieve the last\nstatus message procedure, public, non_overridable :: clear_flag => clear_bspline_flag ../../ to reset the iflag saved in the class. generic, public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots procedure, private :: initialize_6d_auto_knots procedure, private :: initialize_6d_specify_knots procedure, public :: evaluate => evaluate_6d procedure, public :: destroy => destroy_6d procedure, public :: size_of => size_6d Functions private elemental function status_ok (me) result(ok) This routines returns true if the iflag code from the last\nroutine called was =0 . Maybe of the routines have output iflag variables, so they can be checked explicitly, or this routine\ncan be used. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me Return Value logical private pure function get_bspline_status_message (me, iflag) result(msg) Get the status message from a bspline_class routine call. Read more… Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(in) :: me integer(kind=ip), intent(in), optional :: iflag the corresponding status code Return Value character(len=:), allocatable status message associated with the flag private pure function size_1d (me) result(s) Actual size of a bspline_1d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_2d (me) result(s) Actual size of a bspline_2d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_3d (me) result(s) Actual size of a bspline_3d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_4d (me) result(s) Actual size of a bspline_4d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_5d (me) result(s) Actual size of a bspline_5d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure function size_6d (me) result(s) Actual size of a bspline_6d structure in bits. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(in) :: me Return Value integer(kind=ip) size of the structure in bits private pure elemental function bspline_1d_constructor_empty () result(me) It returns an empty bspline_1d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_1d ) private pure function bspline_1d_constructor_auto_knots (x, fcn, kx, extrap) result(me) Constructor for a bspline_1d type (auto knots).\nThis is a wrapper for initialize_1d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private pure function bspline_1d_constructor_specify_knots (x, fcn, kx, tx, extrap) result(me) Constructor for a bspline_1d type (user-specified knots).\nThis is a wrapper for initialize_1d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_1d ) private elemental function bspline_2d_constructor_empty () result(me) It returns an empty bspline_2d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_2d ) private pure function bspline_2d_constructor_auto_knots (x, y, fcn, kx, ky, extrap) result(me) Constructor for a bspline_2d type (auto knots).\nThis is a wrapper for initialize_2d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private pure function bspline_2d_constructor_specify_knots (x, y, fcn, kx, ky, tx, ty, extrap) result(me) Constructor for a bspline_2d type (user-specified knots).\nThis is a wrapper for initialize_2d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_2d ) private elemental function bspline_3d_constructor_empty () result(me) It returns an empty bspline_3d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_3d ) private pure function bspline_3d_constructor_auto_knots (x, y, z, fcn, kx, ky, kz, extrap) result(me) Constructor for a bspline_3d type (auto knots).\nThis is a wrapper for initialize_3d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private pure function bspline_3d_constructor_specify_knots (x, y, z, fcn, kx, ky, kz, tx, ty, tz, extrap) result(me) Constructor for a bspline_3d type (user-specified knots).\nThis is a wrapper for initialize_3d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_3d ) private elemental function bspline_4d_constructor_empty () result(me) It returns an empty bspline_4d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_4d ) private pure function bspline_4d_constructor_auto_knots (x, y, z, q, fcn, kx, ky, kz, kq, extrap) result(me) Constructor for a bspline_4d type (auto knots).\nThis is a wrapper for initialize_4d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private pure function bspline_4d_constructor_specify_knots (x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, extrap) result(me) Constructor for a bspline_4d type (user-specified knots).\nThis is a wrapper for initialize_4d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_4d ) private elemental function bspline_5d_constructor_empty () result(me) It returns an empty bspline_5d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_5d ) private pure function bspline_5d_constructor_auto_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, extrap) result(me) Constructor for a bspline_5d type (auto knots).\nThis is a wrapper for initialize_5d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private pure function bspline_5d_constructor_specify_knots (x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, extrap) result(me) Constructor for a bspline_5d type (user-specified knots).\nThis is a wrapper for initialize_5d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_5d ) private elemental function bspline_6d_constructor_empty () result(me) It returns an empty bspline_6d type. Note that INITIALIZE still\nneeds to be called before it can be used.\nNot really that useful except perhaps in some OpenMP applications. Arguments None Return Value type( bspline_6d ) private pure function bspline_6d_constructor_auto_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, extrap) result(me) Constructor for a bspline_6d type (auto knots).\nThis is a wrapper for initialize_6d_auto_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) private pure function bspline_6d_constructor_specify_knots (x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, extrap) result(me) Constructor for a bspline_6d type (user-specified knots).\nThis is a wrapper for initialize_6d_specify_knots . Arguments Type Intent Optional Attributes Name real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) Return Value type( bspline_6d ) Subroutines private elemental subroutine clear_bspline_flag (me) This sets the iflag variable in the class to 0 (which indicates that everything is OK). It can be used\nafter an error is encountered. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me private pure subroutine destroy_base (me) Destructor for contents of the base bspline_class class.\n(this routine is called by the extended classes). Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me private pure subroutine destroy_1d (me) Destructor for bspline_1d class. Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me private pure subroutine destroy_2d (me) Destructor for bspline_2d class. Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me private pure subroutine destroy_3d (me) Destructor for bspline_3d class. Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me private pure subroutine destroy_4d (me) Destructor for bspline_4d class. Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me private pure subroutine destroy_5d (me) Destructor for bspline_5d class. Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me private pure subroutine destroy_6d (me) Destructor for bspline_6d class. Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me private pure elemental subroutine finalize_1d (me) Finalizer for bspline_1d class. Just a wrapper for destroy_1d . Arguments Type Intent Optional Attributes Name type( bspline_1d ), intent(inout) :: me private pure elemental subroutine finalize_2d (me) Finalizer for bspline_2d class. Just a wrapper for destroy_2d . Arguments Type Intent Optional Attributes Name type( bspline_2d ), intent(inout) :: me private pure elemental subroutine finalize_3d (me) Finalizer for bspline_3d class. Just a wrapper for destroy_3d . Arguments Type Intent Optional Attributes Name type( bspline_3d ), intent(inout) :: me private pure elemental subroutine finalize_4d (me) Finalizer for bspline_4d class. Just a wrapper for destroy_4d . Arguments Type Intent Optional Attributes Name type( bspline_4d ), intent(inout) :: me private pure elemental subroutine finalize_5d (me) Finalizer for bspline_5d class. Just a wrapper for destroy_5d . Arguments Type Intent Optional Attributes Name type( bspline_5d ), intent(inout) :: me private pure elemental subroutine finalize_6d (me) Finalizer for bspline_6d class. Just a wrapper for destroy_6d . Arguments Type Intent Optional Attributes Name type( bspline_6d ), intent(inout) :: me private pure subroutine set_extrap_flag (me, extrap) Sets the extrap flag in the class. Arguments Type Intent Optional Attributes Name class( bspline_class ), intent(inout) :: me logical, intent(in), optional :: extrap if not present, then False is used private pure subroutine initialize_1d_auto_knots (me, x, fcn, kx, iflag, extrap) Initialize a bspline_1d type (with automatically-computed knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_1d_specify_knots (me, x, fcn, kx, tx, iflag, extrap) Initialize a bspline_1d type (with user-specified knots).\nThis is a wrapper for db1ink . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: fcn (nx) array of function values to interpolate. fcn(i) should\ncontain the function value at the point x(i) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db1ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_1d (me, xval, idx, f, iflag) Evaluate a bspline_1d interpolate. This is a wrapper for db1val . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db1val ) private pure subroutine integral_1d (me, x1, x2, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1sqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(out) :: f integral of the b-spline over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) private subroutine fintegral_1d (me, fun, idx, x1, x2, tol, f, iflag) Evaluate a bspline_1d definite integral. This is a wrapper for db1fqad . Arguments Type Intent Optional Attributes Name class( bspline_1d ), intent(inout) :: me procedure( b1fqad_func ) :: fun external function of one argument for the\nintegrand bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv) integer(kind=ip), intent(in) :: idx order of the spline derivative, 0 <= idx <= k-1 idx=0 gives the spline function real(kind=wp), intent(in) :: x1 left point of interval real(kind=wp), intent(in) :: x2 right point of interval real(kind=wp), intent(in) :: tol desired accuracy for the quadrature real(kind=wp), intent(out) :: f integral of bf(x) over integer(kind=ip), intent(out) :: iflag status flag (see db1sqad ) private pure subroutine initialize_2d_auto_knots (me, x, y, fcn, kx, ky, iflag, extrap) Initialize a bspline_2d type (with automatically-computed knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_2d_specify_knots (me, x, y, fcn, kx, ky, tx, ty, iflag, extrap) Initialize a bspline_2d type (with user-specified knots).\nThis is a wrapper for db2ink . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:) :: fcn (nx,ny) matrix of function values to interpolate. fcn(i,j) should contain the function value at the\npoint ( x(i) , y(j) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db2ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_2d (me, xval, yval, idx, idy, f, iflag) Evaluate a bspline_2d interpolate. This is a wrapper for db2val . Arguments Type Intent Optional Attributes Name class( bspline_2d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db2val ) private pure subroutine initialize_3d_auto_knots (me, x, y, z, fcn, kx, ky, kz, iflag, extrap) Initialize a bspline_3d type (with automatically-computed knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_3d_specify_knots (me, x, y, z, fcn, kx, ky, kz, tx, ty, tz, iflag, extrap) Initialize a bspline_3d type (with user-specified knots).\nThis is a wrapper for db3ink . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:) :: fcn (nx,ny,nz) matrix of function values to interpolate. fcn(i,j,k) should contain the function value at the\npoint ( x(i) , y(j) , z(k) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db3ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_3d (me, xval, yval, zval, idx, idy, idz, f, iflag) Evaluate a bspline_3d interpolate. This is a wrapper for db3val . Arguments Type Intent Optional Attributes Name class( bspline_3d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db3val ) private pure subroutine initialize_4d_auto_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, iflag, extrap) Initialize a bspline_4d type (with automatically-computed knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_4d_specify_knots (me, x, y, z, q, fcn, kx, ky, kz, kq, tx, ty, tz, tq, iflag, extrap) Initialize a bspline_4d type (with user-specified knots).\nThis is a wrapper for db4ink . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:) :: fcn (nx,ny,nz,nq) matrix of function values to interpolate. fcn(i,j,k,l) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db4ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_4d (me, xval, yval, zval, qval, idx, idy, idz, idq, f, iflag) Evaluate a bspline_4d interpolate. This is a wrapper for db4val . Arguments Type Intent Optional Attributes Name class( bspline_4d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db4val ) private pure subroutine initialize_5d_auto_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, iflag, extrap) Initialize a bspline_5d type (with automatically-computed knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_5d_specify_knots (me, x, y, z, q, r, fcn, kx, ky, kz, kq, kr, tx, ty, tz, tq, tr, iflag, extrap) Initialize a bspline_5d type (with user-specified knots).\nThis is a wrapper for db5ink . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr) matrix of function values to interpolate. fcn(i,j,k,l,m) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db5ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_5d (me, xval, yval, zval, qval, rval, idx, idy, idz, idq, idr, f, iflag) Evaluate a bspline_5d interpolate. This is a wrapper for db5val . Arguments Type Intent Optional Attributes Name class( bspline_5d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db5val ) private pure subroutine initialize_6d_auto_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, iflag, extrap) Initialize a bspline_6d type (with automatically-computed knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine initialize_6d_specify_knots (me, x, y, z, q, r, s, fcn, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag, extrap) Initialize a bspline_6d type (with user-specified knots).\nThis is a wrapper for db6ink . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in), dimension(:) :: x (nx) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: y (ny) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: z (nz) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: q (nq) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: r (nr) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:) :: s (ns) array of abcissae. Must be strictly increasing. real(kind=wp), intent(in), dimension(:,:,:,:,:,:) :: fcn (nx,ny,nz,nq,nr,ns) matrix of function values to interpolate. fcn(i,j,k,l,m,n) should contain the function value at the\npoint ( x(i) , y(j) , z(k) , q(l) , r(m) , s(n) ) integer(kind=ip), intent(in) :: kx The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ky The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kz The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kq The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: kr The order of spline pieces in ( )\n(order = polynomial degree + 1) integer(kind=ip), intent(in) :: ks The order of spline pieces in ( )\n(order = polynomial degree + 1) real(kind=wp), intent(in), dimension(:) :: tx The (nx+kx) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ty The (ny+ky) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tz The (nz+kz) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tq The (nq+kq) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: tr The (nr+kr) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. real(kind=wp), intent(in), dimension(:) :: ts The (ns+ks) knots in the direction\nfor the spline interpolant.\nMust be non-decreasing. integer(kind=ip), intent(out) :: iflag status flag (see db6ink ) logical, intent(in), optional :: extrap if true, then extrapolation is allowed\n(default is false) private pure subroutine evaluate_6d (me, xval, yval, zval, qval, rval, sval, idx, idy, idz, idq, idr, ids, f, iflag) Evaluate a bspline_6d interpolate. This is a wrapper for db6val . Arguments Type Intent Optional Attributes Name class( bspline_6d ), intent(inout) :: me real(kind=wp), intent(in) :: xval coordinate of evaluation point. real(kind=wp), intent(in) :: yval coordinate of evaluation point. real(kind=wp), intent(in) :: zval coordinate of evaluation point. real(kind=wp), intent(in) :: qval coordinate of evaluation point. real(kind=wp), intent(in) :: rval coordinate of evaluation point. real(kind=wp), intent(in) :: sval coordinate of evaluation point. integer(kind=ip), intent(in) :: idx derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idy derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idz derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idq derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: idr derivative of piecewise polynomial to evaluate. integer(kind=ip), intent(in) :: ids derivative of piecewise polynomial to evaluate. real(kind=wp), intent(out) :: f interpolated value integer(kind=ip), intent(out) :: iflag status flag (see db6val ) private pure subroutine check_knot_vectors_sizes (nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, tx, ty, tz, tq, tr, ts, iflag) Error checks for the user-specified knot vector sizes. Read more… Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: nx integer(kind=ip), intent(in), optional :: ny integer(kind=ip), intent(in), optional :: nz integer(kind=ip), intent(in), optional :: nq integer(kind=ip), intent(in), optional :: nr integer(kind=ip), intent(in), optional :: ns integer(kind=ip), intent(in), optional :: kx integer(kind=ip), intent(in), optional :: ky integer(kind=ip), intent(in), optional :: kz integer(kind=ip), intent(in), optional :: kq integer(kind=ip), intent(in), optional :: kr integer(kind=ip), intent(in), optional :: ks real(kind=wp), intent(in), optional, dimension(:) :: tx real(kind=wp), intent(in), optional, dimension(:) :: ty real(kind=wp), intent(in), optional, dimension(:) :: tz real(kind=wp), intent(in), optional, dimension(:) :: tq real(kind=wp), intent(in), optional, dimension(:) :: tr real(kind=wp), intent(in), optional, dimension(:) :: ts integer(kind=ip), intent(out) :: iflag 0 if everything is OK","tags":"","loc":"module/bspline_oo_module.html"},{"title":"bspline_sub_module.f90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_sub_module.f90~~EfferentGraph sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_sub_module.f90~~AfferentGraph sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! !### Description ! ! Multidimensional (1D-6D) B-spline interpolation of data on a regular grid. ! Basic pure subroutine interface. ! !### Notes ! ! This module is based on the B-spline and spline routines from [1]. ! The original Fortran 77 routines were converted to free-form source. ! Some of them are relatively unchanged from the originals, but some have ! been extensively refactored. In addition, new routines for ! 1d, 4d, 5d, and 6d interpolation were also created (these are simply ! extensions of the same algorithm into higher dimensions). ! !### See also ! * An object-oriented interface can be found in [[bspline_oo_module]]. ! !### References ! ! 1. DBSPLIN and DTENSBS from the ! [NIST Core Math Library](http://www.nist.gov/itl/math/mcsd-software.cfm). ! Original code is public domain. ! 2. Carl de Boor, \"A Practical Guide to Splines\", ! Springer-Verlag, New York, 1978. ! 3. Carl de Boor, [Efficient Computer Manipulation of Tensor ! Products](http://dl.acm.org/citation.cfm?id=355831), ! ACM Transactions on Mathematical Software, ! Vol. 5 (1979), p. 173-182. ! 4. D.E. Amos, \"Computation with Splines and B-Splines\", ! SAND78-1968, Sandia Laboratories, March, 1979. ! 5. Carl de Boor, ! [Package for calculating with B-splines](http://epubs.siam.org/doi/abs/10.1137/0714026), ! SIAM Journal on Numerical Analysis 14, 3 (June 1977), p. 441-472. ! 6. D.E. Amos, \"Quadrature subroutines for splines and B-splines\", ! Report SAND79-1825, Sandia Laboratories, December 1979. module bspline_sub_module use bspline_kinds_module , only : wp , ip use , intrinsic :: iso_fortran_env , only : error_unit implicit none private abstract interface function b1fqad_func ( x ) result ( f ) !! interface for the input function in [[dbfqad]] import :: wp implicit none real ( wp ), intent ( in ) :: x real ( wp ) :: f !! f(x) end function b1fqad_func end interface public :: b1fqad_func integer ( ip ), parameter , public :: bspline_order_linear = 2_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_quadratic = 3_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_cubic = 4_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_quartic = 5_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_quintic = 6_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_hexic = 7_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_heptic = 8_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] integer ( ip ), parameter , public :: bspline_order_octic = 9_ip !! spline order `k` parameter !! (for input to the `db*ink` routines) !! [order = polynomial degree + 1] interface db1ink !! 1D initialization routines. module procedure :: db1ink_default , db1ink_alt , db1ink_alt_2 end interface interface db1val !! 1D evaluation routines. module procedure :: db1val_default , db1val_alt end interface !main routines: public :: db1ink , db1val , db1sqad , db1fqad public :: db2ink , db2val public :: db3ink , db3val public :: db4ink , db4val public :: db5ink , db5val public :: db6ink , db6val public :: get_status_message contains !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the one-dimensional gridded data ! [x(i),\\mathrm{fcn}(i)] ~\\mathrm{for}~ i=1,..,n_x ! The interpolating function and its derivatives may ! subsequently be evaluated by the function [[db1val]]. ! !### History ! * Jacob Williams, 10/30/2015 : Created 1D routine. pure subroutine db1ink_default ( x , nx , fcn , kx , iknot , tx , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant: !! !! * If `iknot=0` these are chosen by [[db1ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( out ) :: bcoef !! `(nx)` array of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)`. !! * 706 = `size(x)` \\ne `nx`. !! * 712 = `size(tx)` \\ne `nx+kx`. !! * 800 = `size(x)` \\ne `size(bcoef,1)`. logical :: status_ok real ( wp ), dimension (:), allocatable :: work !! work array of dimension `2*kx*(nx+1)` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) end if allocate ( work ( 2_ip * kx * ( nx + 1_ip ))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , 1_ip , tx , kx , bcoef , work , iflag ) deallocate ( work ) end if end subroutine db1ink_default !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[db1ink_default]], where the boundary conditions can be specified. ! !### History ! * Jacob Williams, 9/4/2018 : created this routine. ! !### See also ! * [[dbint4]] -- the main routine that is called here. ! !@note Currently, this only works for 3rd order (k=4). pure subroutine db1ink_alt ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , kntopt , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(nx+3)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(nx+3)` real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when `k=4` real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (n=nx+2) integer ( ip ) :: k !! order of spline (k=4) logical :: status_ok !! status flag for error checking real ( wp ), dimension ( 3 ), parameter :: tleft = 0.0_wp !! not used for this case (see [[dbint4]]) real ( wp ), dimension ( 3 ), parameter :: tright = 0.0_wp !! not used for this case (see [[dbint4]]) if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5_ip , nx + 2_ip )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[db1ink_alt]], where the first and ! last 3 knots are specified by the user. ! !### History ! * Jacob Williams, 9/4/2018 : created this routine. ! !### See also ! * [[dbint4]] -- the main routine that is called here. ! !@note Currently, this only works for 3rd order (k=4). pure subroutine db1ink_alt_2 ( x , nx , fcn , kx , ibcl , ibcr , fbcl , fbcr , tleft , tright , tx , bcoef , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `nx`, distinct !! and in increasing order integer ( ip ), intent ( in ) :: nx !! number of data points, n_x \\ge 2 real ( wp ), dimension (:), intent ( in ) :: fcn !! y vector of ordinates of length `nx` integer ( ip ), intent ( in ) :: kx !! spline order (Currently, this must be `4`) integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(nx)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(nx)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! `t(1:3)` in increasing order supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! `t(nx+4:nx+6)` in increasing order supplied by the user. real ( wp ), dimension (:), intent ( out ) :: tx !! knot array of length `nx+6` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `nx+2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 806: [[dbint4]] can only be used when k=4 real ( wp ), dimension (:,:), allocatable :: w !! work array of dimension `5,nx+2` integer ( ip ) :: n !! number of coefficients (`n=nx+2`) integer ( ip ) :: k !! order of spline (`k=4`) logical :: status_ok !! status flag for error checking integer ( ip ), parameter :: kntopt = 3 !! use `tleft` and `tright` in [[dbint4]] if ( kx /= 4_ip ) then iflag = 806_ip else call check_inputs ( 1_ip ,& ! so it will check size of t iflag ,& nx = nx ,& kx = kx ,& x = x ,& f1 = fcn ,& bcoef1 = bcoef ,& tx = tx ,& status_ok = status_ok ,& alt = . true .) if ( status_ok ) then allocate ( w ( 5 , nx + 2 )) call dbint4 ( x , fcn , nx , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , tx , bcoef , n , k , w , iflag ) deallocate ( w ) end if end if end subroutine db1ink_alt_2 !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db1ink]] or one of its ! derivatives at the point `xval`. ! ! To evaluate the interpolant itself, set `idx=0`, ! to evaluate the first partial with respect to `x`, set `idx=1`, and so on. ! ! [[db1val]] returns 0.0 if (`xval`,`yval`) is out of range. that is, if !```fortran ! xval < tx(1) .or. xval > tx(nx+kx) !``` ! if the knots `tx` were chosen by [[db1ink]], then this is equivalent to: !```fortran ! xval < x(1) .or. xval > x(nx)+epsx !``` ! where !```fortran ! epsx = 0.1*(x(nx)-x(nx-1)) !``` ! ! The input quantities `tx`, `nx`, `kx`, and `bcoef` should be ! unchanged since the last call of [[db1ink]]. ! !### History ! * Jacob Williams, 10/30/2015 : Created 1D routine. pure subroutine db1val_default ( xval , idx , tx , nx , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db1ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db1ink]]) real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , nx , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_default !***************************************************************************************** !***************************************************************************************** !> ! Alternate version of [[db1val_default]] for use with [[db1ink_alt]] and [[db1ink_alt_2]]. pure subroutine db1val_alt ( xval , idx , tx , nx , n , kx , bcoef , f , iflag , inbvx , w0 , extrap ) implicit none real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. integer ( ip ), intent ( in ) :: n !! length of `bcoef`: `nx+2` integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db1ink]]) real ( wp ), dimension ( n + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db1ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return call dbvalu ( tx , bcoef , n , kx , idx , xval , inbvx , w0 , iflag , f , extrap ) end subroutine db1val_alt !***************************************************************************************** !***************************************************************************************** !> ! Computes the integral on `(x1,x2)` of a `kx`-th order b-spline. ! Orders `kx` as high as 20 are permitted by applying a 2, 6, or 10 ! point gauss formula on subintervals of `(x1,x2)` which are ! formed by included (distinct) knots. ! !### See also ! * [[dbsqad]] -- the core routine. pure subroutine db1sqad ( tx , bcoef , nx , kx , x1 , x2 , f , iflag , w0 ) implicit none integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `1 <= k <= 20` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(kx) <= x <= t(nx+1)` real ( wp ), intent ( out ) :: f !! integral of the b-spline over (`x1`,`x2`) integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3 * kx ), intent ( inout ) :: w0 !! work array for [[dbsqad]] call dbsqad ( tx , bcoef , nx , kx , x1 , x2 , f , w0 , iflag ) end subroutine db1sqad !***************************************************************************************** !***************************************************************************************** !> ! Computes the integral on `(x1,x2)` of a product of a ! function `fun` and the `idx`-th derivative of a `kx`-th order b-spline, ! using the b-representation `(tx,bcoef,nx,kx)`, with an adaptive ! 8-point Legendre-Gauss algorithm. ! `(x1,x2)` must be a subinterval of `t(kx) <= x <= t(nx+1)`. ! !### See also ! * [[dbfqad]] -- the core routine. ! !@note This one is not pure, because we are not enforcing ! that the user function `fun` be pure. subroutine db1fqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) implicit none procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,id,x,inbv,work)` integer ( ip ), intent ( in ) :: nx !! length of coefficient array integer ( ip ), intent ( in ) :: kx !! order of b-spline, `kx >= 1` real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! knot array real ( wp ), dimension ( nx ), intent ( in ) :: bcoef !! b-spline coefficient array integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: f !! integral of `bf(x)` on `(x1,x2)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error real ( wp ), dimension ( 3_ip * kx ), intent ( inout ) :: w0 !! work array for [[dbfqad]] call dbfqad ( fun , tx , bcoef , nx , kx , idx , x1 , x2 , tol , f , iflag , w0 ) end subroutine db1fqad !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the two-dimensional gridded data ! [x(i),y(j),\\mathrm{fcn}(i,j)] ~\\mathrm{for}~ i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y ! The interpolating function and its derivatives may ! subsequently be evaluated by the function [[db2val]]. ! ! The interpolating function is a piecewise polynomial function ! represented as a tensor product of one-dimensional b-splines. the ! form of this function is ! ! s(x,y) = \\sum_{i=1}^{n_x} \\sum_{j=1}^{n_y} a_{ij} u_i(x) v_j(y) ! ! where the functions u_i and v_j are one-dimensional b-spline ! basis functions. the coefficients a_{ij} are chosen so that ! ! s(x(i),y(j)) = \\mathrm{fcn}(i,j) ~\\mathrm{for}~ i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y ! ! Note that for each fixed value of y, s(x,y) is a piecewise ! polynomial function of x alone, and for each fixed value of x, s(x,y) ! is a piecewise polynomial function of y alone. in one dimension ! a piecewise polynomial may be created by partitioning a given ! interval into subintervals and defining a distinct polynomial piece ! on each one. the points where adjacent subintervals meet are called ! knots. each of the functions u_i and v_j above is a piecewise ! polynomial. ! ! Users of [[db2ink]] choose the order (degree+1) of the polynomial ! pieces used to define the piecewise polynomial in each of the x and ! y directions (`kx` and `ky`). users also may define their own knot ! sequence in x and y separately (`tx` and `ty`). if `iflag=0`, however, ! [[db2ink]] will choose sequences of knots that result in a piecewise ! polynomial interpolant with `kx-2` continuous partial derivatives in ! x and `ky-2` continuous partial derivatives in y. (`kx` knots are taken ! near each endpoint in the x direction, not-a-knot end conditions ! are used, and the remaining knots are placed at data points if `kx` ! is even or at midpoints between data points if `kx` is odd. the y ! direction is treated similarly.) ! ! After a call to [[db2ink]], all information necessary to define the ! interpolating function are contained in the parameters `nx`, `ny`, `kx`, ! `ky`, `tx`, `ty`, and `bcoef`. These quantities should not be altered until ! after the last call of the evaluation routine [[db2val]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , tx , ty , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! Number of x abcissae integer ( ip ), intent ( in ) :: ny !! Number of y abcissae integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db1ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db2ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:), intent ( out ) :: bcoef !! `(nx,ny)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1),2*ky*(ny+1))` !check validity of inputs call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny ,& kx = kx , ky = ky ,& x = x , y = y ,& tx = tx , ty = ty ,& f2 = fcn ,& bcoef2 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then !choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) end if allocate ( temp ( nx * ny )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip )))) !construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx , ty , ky , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db2ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db2ink]] or one of its ! derivatives at the point (`xval`,`yval`). ! ! To evaluate the interpolant ! itself, set `idx=idy=0`, to evaluate the first partial with respect ! to `x`, set `idx=1,idy=0`, and so on. ! ! [[db2val]] returns 0.0 if `(xval,yval)` is out of range. that is, if !```fortran ! xval < tx(1) .or. xval > tx(nx+kx) .or. ! yval < ty(1) .or. yval > ty(ny+ky) !``` ! if the knots tx and ty were chosen by [[db2ink]], then this is equivalent to: !```fortran ! xval < x(1) .or. xval > x(nx)+epsx .or. ! yval < y(1) .or. yval > y(ny)+epsy !``` ! where !```fortran ! epsx = 0.1*(x(nx)-x(nx-1)) ! epsy = 0.1*(y(ny)-y(ny-1)) !``` ! ! The input quantities `tx`, `ty`, `nx`, `ny`, `kx`, `ky`, and `bcoef` should be ! unchanged since the last call of [[db2ink]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db2val ( xval , yval , idx , idy , tx , ty , nx , ny , kx , ky , bcoef , f , iflag , inbvx , inbvy , iloy , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db2ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db2ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise !! polynomial in the y direction. !! (same as in last call to [[db2ink]]) real ( wp ), dimension ( nx , ny ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db2ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set to 1 !! the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: k , lefty , kcol f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return kcol = lefty - ky do k = 1_ip , ky kcol = kcol + 1_ip call dbvalu ( tx , bcoef (:, kcol ), nx , kx , idx , xval , inbvx , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return !error end do kcol = lefty - ky + 1_ip call dbvalu ( ty ( kcol :), w1 , ky , ky , idy , yval , inbvy , w0 , iflag , f , extrap ) end subroutine db2val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the three-dimensional gridded data ! [x(i),y(j),z(k),\\mathrm{fcn}(i,j,k)] ~\\mathrm{for}~ ! i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y, ~\\mathrm{and}~ k=1,..,n_z ! The interpolating function and ! its derivatives may subsequently be evaluated by the function ! [[db3val]]. ! ! The interpolating function is a piecewise polynomial function ! represented as a tensor product of one-dimensional b-splines. the ! form of this function is ! s(x,y,z) = \\sum_{i=1}^{n_x} \\sum_{j=1}^{n_y} \\sum_{k=1}^{n_z} ! a_{ijk} u_i(x) v_j(y) w_k(z) ! ! where the functions u_i, v_j, and w_k are one-dimensional b- ! spline basis functions. the coefficients a_{ijk} are chosen so that: ! ! s(x(i),y(j),z(k)) = \\mathrm{fcn}(i,j,k) ! ~\\mathrm{for}~ i=1,..,n_x , j=1,..,n_y , k=1,..,n_z ! ! Note that for fixed values of y and z s(x,y,z) is a piecewise ! polynomial function of x alone, for fixed values of x and z s(x,y,z) ! is a piecewise polynomial function of y alone, and for fixed ! values of x and y s(x,y,z) is a function of z alone. in one ! dimension a piecewise polynomial may be created by partitioning a ! given interval into subintervals and defining a distinct polynomial ! piece on each one. the points where adjacent subintervals meet are ! called knots. each of the functions u_i, v_j, and w_k above is a ! piecewise polynomial. ! ! Users of [[db3ink]] choose the order (degree+1) of the polynomial ! pieces used to define the piecewise polynomial in each of the x, y, ! and z directions (`kx`, `ky`, and `kz`). users also may define their own ! knot sequence in x, y, z separately (`tx`, `ty`, and `tz`). if `iflag=0`, ! however, [[db3ink]] will choose sequences of knots that result in a ! piecewise polynomial interpolant with `kx-2` continuous partial ! derivatives in x, `ky-2` continuous partial derivatives in y, and `kz-2` ! continuous partial derivatives in z. (`kx` knots are taken near ! each endpoint in x, not-a-knot end conditions are used, and the ! remaining knots are placed at data points if `kx` is even or at ! midpoints between data points if `kx` is odd. the y and z directions ! are treated similarly.) ! ! After a call to [[db3ink]], all information necessary to define the ! interpolating function are contained in the parameters `nx`, `ny`, `nz`, ! `kx`, `ky`, `kz`, `tx`, `ty`, `tz`, and `bcoef`. these quantities should not be ! altered until after the last call of the evaluation routine [[db3val]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db3ink ( x , nx , y , ny , z , nz , fcn , kx , ky , kz , iknot , tx , ty , tz , bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. `fcn(i,j,k)` should !! contain the function value at the point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db3ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db3ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz)` matrix of coefficients of the b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `ty` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1))` integer ( ip ) :: i , j , k , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz ,& kx = kx , ky = ky , kz = kz ,& x = x , y = y , z = z ,& tx = tx , ty = ty , tz = tz ,& f3 = fcn ,& bcoef3 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) end if allocate ( temp ( nx * ny * nz )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp = reshape( fcn, [nx*ny*nz] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k ) end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny , tz , kz , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db3ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db3ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=0`, to evaluate the first ! partial with respect to `x`, set `idx=1`,`idy=idz=0`, and so on. ! ! [[db3val]] returns 0.0 if (`xval`,`yval`,`zval`) is out of range. that is, !```fortran ! xvaltx(nx+kx) .or. ! yvalty(ny+ky) .or. ! zvaltz(nz+kz) !``` ! if the knots `tx`, `ty`, and `tz` were chosen by [[db3ink]], then this is ! equivalent to !```fortran ! xvalx(nx)+epsx .or. ! yvaly(ny)+epsy .or. ! zvalz(nz)+epsz !``` ! where !```fortran ! epsx = 0.1*(x(nx)-x(nx-1)) ! epsy = 0.1*(y(ny)-y(ny-1)) ! epsz = 0.1*(z(nz)-z(nz-1)) !``` ! ! The input quantities `tx`, `ty`, `tz`, `nx`, `ny`, `nz`, `kx`, `ky`, `kz`, and `bcoef` ! should remain unchanged since the last call of [[db3ink]]. ! !### History ! * Boisvert, Ronald, NBS : 25 may 1982 : Author of original routine. ! * JEC : 000330 modified array declarations. ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine db3val ( xval , yval , zval , idx , idy , idz ,& tx , ty , tz ,& nx , ny , nz , kx , ky , kz , bcoef , f , iflag ,& inbvx , inbvy , inbvz , iloy , iloz , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db3ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db3ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to [[db3ink]]) real ( wp ), dimension ( nx , ny , nz ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db3ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be !! set to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kz ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , kcoly , kcolz , j , k f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz ), nx , kx , idx , xval , inbvx , w0 , iflag , w2 ( j , k ), extrap ) if ( iflag /= 0_ip ) return end do end do kcoly = lefty - ky + 1_ip do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w2 (:, k ), ky , ky , idy , yval , inbvy , w0 , iflag , w1 ( k ), extrap ) if ( iflag /= 0_ip ) return end do kcolz = leftz - kz + 1_ip call dbvalu ( tz ( kcolz :), w1 , kz , kz , idz , zval , inbvz , w0 , iflag , f , extrap ) end subroutine db3val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the four-dimensional gridded data ! [x(i),y(j),z(k),q(l),\\mathrm{fcn}(i,j,k,l)] ~\\mathrm{for}~ ! i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y, ~\\mathrm{and}~ k=1,..,n_z, ! ~\\mathrm{and}~ l=1,..,n_q ! The interpolating function and its derivatives may ! subsequently be evaluated by the function [[db4val]]. ! ! See [[db3ink]] header for more details. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& tx , ty , tz , tq ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,q)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db4ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db4ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 712 = `size(tx`) \\ne `nx+kx` !! * 713 = `size(ty`) \\ne `ny+ky` !! * 714 = `size(tz`) \\ne `nz+kz` !! * 715 = `size(tq`) \\ne `nq+kq` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of dimension `nx*ny*nz*nq` real ( wp ), dimension (:), allocatable :: work !! work array of dimension `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq ,& kx = kx , ky = ky , kz = kz , kq = kq ,& x = x , y = y , z = z , q = q ,& tx = tx , ty = ty , tz = tz , tq = tq ,& f4 = fcn ,& bcoef4 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) end if allocate ( temp ( nx * ny * nz * nq )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz , tq , kq , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db4ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db4ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`,`qval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=idq=0`, to evaluate the first ! partial with respect to `x`, set `idx=1,idy=idz=idq=0`, and so on. ! ! See [[db3val]] header for more information. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& tx , ty , tz , tq ,& nx , ny , nz , nq ,& kx , ky , kz , kq ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq ,& iloy , iloz , iloq , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db4ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db4ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. (same as in last call to !! [[db4ink]]) real ( wp ), dimension ( nx , ny , nz , nq ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db4ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kz , kq ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kq ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , & kcoly , kcolz , kcolq , j , k , q f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w3 ( j , k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! y -> z, q kcoly = lefty - ky + 1_ip do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w3 (:, k , q ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w2 ( k , q ), extrap ) if ( iflag /= 0_ip ) return end do end do ! z -> q kcolz = leftz - kz + 1_ip do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w2 (:, q ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w1 ( q ), extrap ) if ( iflag /= 0_ip ) return end do ! q kcolq = leftq - kq + 1_ip call dbvalu ( tq ( kcolq :), w1 , kq , kq , idq , qval , inbvq , w0 , iflag , f , extrap ) end subroutine db4val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the five-dimensional gridded data: ! ! [x(i),y(j),z(k),q(l),r(m),\\mathrm{fcn}(i,j,k,l,m)] ! ! for: ! ! i=1,..,n_x ~\\mathrm{and}~ j=1,..,n_y, ~\\mathrm{and}~ k=1,..,n_z, ! ~\\mathrm{and}~ l=1,..,n_q, ~\\mathrm{and}~ m=1,..,n_r ! ! The interpolating function and its derivatives may subsequently be evaluated ! by the function [[db5val]]. ! ! See [[db3ink]] header for more details. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& tx , ty , tz , tq , tr ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ). !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ). !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,q,r)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db5ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the spline !! interpolant. !! !! * If `iknot=0` these are chosen by [[db5ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr)` matrix of coefficients of the b-spline !! interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 700 = `size(x)` \\ne `size(fcn,1)` !! * 701 = `size(y)` \\ne `size(fcn,2)` !! * 702 = `size(z)` \\ne `size(fcn,3)` !! * 703 = `size(q)` \\ne `size(fcn,4)` !! * 704 = `size(r)` \\ne `size(fcn,5)` !! * 706 = `size(x)` \\ne `nx` !! * 707 = `size(y)` \\ne `ny` !! * 708 = `size(z)` \\ne `nz` !! * 709 = `size(q)` \\ne `nq` !! * 710 = `size(r)` \\ne `nr` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 800 = `size(x)` \\ne `size(bcoef,1)` !! * 801 = `size(y)` \\ne `size(bcoef,2)` !! * 802 = `size(z)` \\ne `size(bcoef,3)` !! * 803 = `size(q)` \\ne `size(bcoef,4)` !! * 804 = `size(r)` \\ne `size(bcoef,5)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of length `nx*ny*nz*nq*nr` real ( wp ), dimension (:), allocatable :: work !! work array of length `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1),2*kr*(nr+1))` integer ( ip ) :: i , j , k , l , m , ii !! counter ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr ,& x = x , y = y , z = z , q = q , r = r ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr ,& f5 = fcn ,& bcoef5 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) end if allocate ( temp ( nx * ny * nz * nq * nr )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ), 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ), 2_ip * kr * ( nr + 1_ip )))) ! copy fcn to work in packed for dbtpcf !temp(1:nx*ny*nz*nq*nr) = reshape( fcn, [nx*ny*nz*nq*nr] ) ! replaced with loops to avoid stack ! overflow for large data set: ii = 0_ip do m = 1_ip , nr do l = 1_ip , nq do k = 1_ip , nz do j = 1_ip , ny do i = 1_ip , nx ii = ii + 1_ip temp ( ii ) = fcn ( i , j , k , l , m ) end do end do end do end do end do ! construct b-spline coefficients call dbtpcf ( x , nx , temp , nx , ny * nz * nq * nr , tx , kx , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , bcoef , ny , nx * nz * nq * nr , ty , ky , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , temp , nz , nx * ny * nq * nr , tz , kz , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , bcoef , nq , nx * ny * nz * nr , tq , kq , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , temp , nr , nx * ny * nz * nq , tr , kr , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db5ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db5ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`,`qval`,`rval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=idq=idr=0`, to evaluate the first ! partial with respect to `x`, set `idx=1,idy=idz=idq=idr=0,` and so on. ! ! See [[db3val]] header for more information. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& tx , ty , tz , tq , tr ,& nx , ny , nz , nq , nr ,& kx , ky , kz , kq , kr ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr ,& iloy , iloz , iloq , ilor ,& w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db5ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db5ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db5ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db5ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kz , kq , kr ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kq , kr ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( kr ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , & kcoly , kcolz , kcolq , kcolr , j , k , q , r f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr ),& nx , kx , idx , xval , inbvx , w0 , iflag , w4 ( j , k , q , r ),& extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! y -> z, q, r kcoly = lefty - ky + 1_ip do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w4 (:, k , q , r ), ky , ky , idy , yval , inbvy ,& w0 , iflag , w3 ( k , q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! z -> q, r kcolz = leftz - kz + 1_ip do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w3 (:, q , r ), kz , kz , idz , zval , inbvz ,& w0 , iflag , w2 ( q , r ), extrap ) if ( iflag /= 0_ip ) return end do end do ! q -> r kcolq = leftq - kq + 1_ip do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w2 (:, r ), kq , kq , idq , qval , inbvq ,& w0 , iflag , w1 ( r ), extrap ) if ( iflag /= 0_ip ) return end do ! r kcolr = leftr - kr + 1_ip call dbvalu ( tr ( kcolr :), w1 , kr , kr , idr , rval , inbvr , w0 , iflag , f , extrap ) end subroutine db5val !***************************************************************************************** !***************************************************************************************** !> ! Determines the parameters of a function that interpolates ! the six-dimensional gridded data: ! ! [x(i),y(j),z(k),q(l),r(m),s(n),\\mathrm{fcn}(i,j,k,l,m,n)] ! ! for: ! ! i=1,..,n_x, j=1,..,n_y, k=1,..,n_z, l=1,..,n_q, m=1,..,n_r, n=1,..,n_s ! ! the interpolating function and its derivatives may subsequently be evaluated ! by the function [[db6val]]. ! ! See [[db3ink]] header for more details. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& tx , ty , tz , tq , tr , ts ,& bcoef , iflag ) implicit none integer ( ip ), intent ( in ) :: nx !! number of x abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ny !! number of y abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nz !! number of z abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nq !! number of q abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: nr !! number of r abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: ns !! number of s abcissae ( \\ge 3 ) integer ( ip ), intent ( in ) :: kx !! the order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! the order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! the order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! the order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! the order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! the order of spline pieces in s !! ( 2 \\le k_s < n_s ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. !! must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. !! must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to !! interpolate. `fcn(i,j,k,q,r,s)` should contain the !! function value at the point !! (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: iknot !! knot sequence flag: !! !! * 0 = knot sequence chosen by [[db6ink]]. !! * 1 = knot sequence chosen by user. real ( wp ), dimension (:), intent ( inout ) :: tx !! The `(nx+kx)` knots in the x direction for the !! spline interpolant. !! !! * f `iknot=0` these are chosen by [[db6ink]]. !! * f `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ty !! The `(ny+ky)` knots in the y direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tz !! The `(nz+kz)` knots in the z direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tq !! The `(nq+kq)` knots in the q direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: tr !! The `(nr+kr)` knots in the r direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:), intent ( inout ) :: ts !! The `(ns+ks)` knots in the s direction for the !! spline interpolant. !! !! * If `iknot=0` these are chosen by [[db6ink]]. !! * If `iknot=1` these are specified by the user. !! !! Must be non-decreasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( out ) :: bcoef !! `(nx,ny,nz,nq,nr,ns)` matrix of coefficients of the !! b-spline interpolant. integer ( ip ), intent ( out ) :: iflag !! * 0 = successful execution. !! * 2 = `iknot` out of range. !! * 3 = `nx` out of range. !! * 4 = `kx` out of range. !! * 5 = `x` not strictly increasing. !! * 6 = `tx` not non-decreasing. !! * 7 = `ny` out of range. !! * 8 = `ky` out of range. !! * 9 = `y` not strictly increasing. !! * 10 = `ty` not non-decreasing. !! * 11 = `nz` out of range. !! * 12 = `kz` out of range. !! * 13 = `z` not strictly increasing. !! * 14 = `tz` not non-decreasing. !! * 15 = `nq` out of range. !! * 16 = `kq` out of range. !! * 17 = `q` not strictly increasing. !! * 18 = `tq` not non-decreasing. !! * 19 = `nr` out of range. !! * 20 = `kr` out of range. !! * 21 = `r` not strictly increasing. !! * 22 = `tr` not non-decreasing. !! * 23 = `ns` out of range. !! * 24 = `ks` out of range. !! * 25 = `s` not strictly increasing. !! * 26 = `ts` not non-decreasing. !! * 700 = `size(x) ` \\ne `size(fcn,1)` !! * 701 = `size(y) ` \\ne `size(fcn,2)` !! * 702 = `size(z) ` \\ne `size(fcn,3)` !! * 703 = `size(q) ` \\ne `size(fcn,4)` !! * 704 = `size(r) ` \\ne `size(fcn,5)` !! * 705 = `size(s) ` \\ne `size(fcn,6)` !! * 706 = `size(x) ` \\ne `nx` !! * 707 = `size(y) ` \\ne `ny` !! * 708 = `size(z) ` \\ne `nz` !! * 709 = `size(q) ` \\ne `nq` !! * 710 = `size(r) ` \\ne `nr` !! * 711 = `size(s) ` \\ne `ns` !! * 712 = `size(tx)` \\ne `nx+kx` !! * 713 = `size(ty)` \\ne `ny+ky` !! * 714 = `size(tz)` \\ne `nz+kz` !! * 715 = `size(tq)` \\ne `nq+kq` !! * 716 = `size(tr)` \\ne `nr+kr` !! * 717 = `size(ts)` \\ne `ns+ks` !! * 800 = `size(x) ` \\ne `size(bcoef,1)` !! * 801 = `size(y) ` \\ne `size(bcoef,2)` !! * 802 = `size(z) ` \\ne `size(bcoef,3)` !! * 803 = `size(q) ` \\ne `size(bcoef,4)` !! * 804 = `size(r) ` \\ne `size(bcoef,5)` !! * 805 = `size(s) ` \\ne `size(bcoef,6)` logical :: status_ok real ( wp ), dimension (:), allocatable :: temp !! work array of size `nx*ny*nz*nq*nr*ns` real ( wp ), dimension (:), allocatable :: work !! work array of size `max(2*kx*(nx+1), !! 2*ky*(ny+1),2*kz*(nz+1),2*kq*(nq+1), !! 2*kr*(nr+1),2*ks*(ns+1))` ! check validity of input call check_inputs ( iknot ,& iflag ,& nx = nx , ny = ny , nz = nz , nq = nq , nr = nr , ns = ns ,& kx = kx , ky = ky , kz = kz , kq = kq , kr = kr , ks = ks ,& x = x , y = y , z = z , q = q , r = r , s = s ,& tx = tx , ty = ty , tz = tz , tq = tq , tr = tr , ts = ts ,& f6 = fcn ,& bcoef6 = bcoef ,& status_ok = status_ok ) if ( status_ok ) then ! choose knots if ( iknot == 0_ip ) then call dbknot ( x , nx , kx , tx ) call dbknot ( y , ny , ky , ty ) call dbknot ( z , nz , kz , tz ) call dbknot ( q , nq , kq , tq ) call dbknot ( r , nr , kr , tr ) call dbknot ( s , ns , ks , ts ) end if allocate ( temp ( nx * ny * nz * nq * nr * ns )) allocate ( work ( max ( 2_ip * kx * ( nx + 1_ip ), 2_ip * ky * ( ny + 1_ip ),& 2_ip * kz * ( nz + 1_ip ), 2_ip * kq * ( nq + 1_ip ),& 2_ip * kr * ( nr + 1_ip ), 2_ip * ks * ( ns + 1_ip )))) ! construct b-spline coefficients call dbtpcf ( x , nx , fcn , nx , ny * nz * nq * nr * ns , tx , kx , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( y , ny , temp , ny , nx * nz * nq * nr * ns , ty , ky , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( z , nz , bcoef , nz , nx * ny * nq * nr * ns , tz , kz , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( q , nq , temp , nq , nx * ny * nz * nr * ns , tq , kq , bcoef , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( r , nr , bcoef , nr , nx * ny * nz * nq * ns , tr , kr , temp , work , iflag ) if ( iflag == 0_ip ) call dbtpcf ( s , ns , temp , ns , nx * ny * nz * nq * nr , ts , ks , bcoef , work , iflag ) deallocate ( temp ) deallocate ( work ) end if end subroutine db6ink !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the tensor product piecewise polynomial ! interpolant constructed by the routine [[db6ink]] or one of its ! derivatives at the point (`xval`,`yval`,`zval`,`qval`,`rval`,`sval`). ! ! To evaluate the ! interpolant itself, set `idx=idy=idz=idq=idr=ids=0`, to evaluate the first ! partial with respect to `x`, set `idx=1,idy=idz=idq=idr=ids=0`, and so on. ! ! See [[db3val]] header for more information. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& tx , ty , tz , tq , tr , ts ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& bcoef , f , iflag ,& inbvx , inbvy , inbvz , inbvq , inbvr , inbvs ,& iloy , iloz , iloq , ilor , ilos ,& w5 , w4 , w3 , w2 , w1 , w0 , extrap ) implicit none integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: nx !! the number of interpolation points in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ny !! the number of interpolation points in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nz !! the number of interpolation points in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nq !! the number of interpolation points in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: nr !! the number of interpolation points in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ns !! the number of interpolation points in s. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kx !! order of polynomial pieces in x. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ky !! order of polynomial pieces in y. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kz !! order of polynomial pieces in z. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kq !! order of polynomial pieces in q. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: kr !! order of polynomial pieces in r. !! (same as in last call to [[db6ink]]) integer ( ip ), intent ( in ) :: ks !! order of polynomial pieces in s. !! (same as in last call to [[db6ink]]) real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. real ( wp ), dimension ( nx + kx ), intent ( in ) :: tx !! sequence of knots defining the piecewise polynomial !! in the x direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ny + ky ), intent ( in ) :: ty !! sequence of knots defining the piecewise polynomial !! in the y direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nz + kz ), intent ( in ) :: tz !! sequence of knots defining the piecewise polynomial !! in the z direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nq + kq ), intent ( in ) :: tq !! sequence of knots defining the piecewise polynomial !! in the q direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nr + kr ), intent ( in ) :: tr !! sequence of knots defining the piecewise polynomial !! in the r direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( ns + ks ), intent ( in ) :: ts !! sequence of knots defining the piecewise polynomial !! in the s direction. !! (same as in last call to [[db6ink]]) real ( wp ), dimension ( nx , ny , nz , nq , nr , ns ), intent ( in ) :: bcoef !! the b-spline coefficients computed by [[db6ink]]. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * = 0 : no errors !! * \\ne 0 : error integer ( ip ), intent ( inout ) :: inbvx !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvr !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: inbvs !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloy !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloz !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: iloq !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilor !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. integer ( ip ), intent ( inout ) :: ilos !! initialization parameter which must be set !! to 1 the first time this routine is called, !! and must not be changed by the user. real ( wp ), dimension ( ky , kz , kq , kr , ks ), intent ( inout ) :: w5 !! work array real ( wp ), dimension ( kz , kq , kr , ks ), intent ( inout ) :: w4 !! work array real ( wp ), dimension ( kq , kr , ks ), intent ( inout ) :: w3 !! work array real ( wp ), dimension ( kr , ks ), intent ( inout ) :: w2 !! work array real ( wp ), dimension ( ks ), intent ( inout ) :: w1 !! work array real ( wp ), dimension ( 3_ip * max ( kx , ky , kz , kq , kr , ks )), intent ( inout ) :: w0 !! work array logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: lefty , leftz , leftq , leftr , lefts ,& kcoly , kcolz , kcolq , kcolr , kcols ,& j , k , q , r , s f = 0.0_wp iflag = check_value ( xval , tx , 1_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( yval , ty , 2_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( zval , tz , 3_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( qval , tq , 4_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( rval , tr , 5_ip , extrap ); if ( iflag /= 0_ip ) return iflag = check_value ( sval , ts , 6_ip , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ty , ny + ky , yval , iloy , lefty , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tz , nz + kz , zval , iloz , leftz , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tq , nq + kq , qval , iloq , leftq , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( tr , nr + kr , rval , ilor , leftr , iflag , extrap ); if ( iflag /= 0_ip ) return call dintrv ( ts , ns + ks , sval , ilos , lefts , iflag , extrap ); if ( iflag /= 0_ip ) return iflag = 0_ip ! x -> y, z, q, r, s kcols = lefts - ks do s = 1_ip , ks kcols = kcols + 1_ip kcolr = leftr - kr do r = 1_ip , kr kcolr = kcolr + 1_ip kcolq = leftq - kq do q = 1_ip , kq kcolq = kcolq + 1_ip kcolz = leftz - kz do k = 1_ip , kz kcolz = kcolz + 1_ip kcoly = lefty - ky do j = 1_ip , ky kcoly = kcoly + 1_ip call dbvalu ( tx , bcoef (:, kcoly , kcolz , kcolq , kcolr , kcols ),& nx , kx , idx , xval , inbvx , w0 , iflag ,& w5 ( j , k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do end do ! y -> z, q, r, s kcoly = lefty - ky + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq do k = 1_ip , kz call dbvalu ( ty ( kcoly :), w5 (:, k , q , r , s ),& ky , ky , idy , yval , inbvy , w0 , iflag ,& w4 ( k , q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do end do ! z -> q, r, s kcolz = leftz - kz + 1_ip do s = 1_ip , ks do r = 1_ip , kr do q = 1_ip , kq call dbvalu ( tz ( kcolz :), w4 (:, q , r , s ),& kz , kz , idz , zval , inbvz , w0 , iflag ,& w3 ( q , r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do end do ! q -> r, s kcolq = leftq - kq + 1_ip do s = 1_ip , ks do r = 1_ip , kr call dbvalu ( tq ( kcolq :), w3 (:, r , s ),& kq , kq , idq , qval , inbvq , w0 , iflag ,& w2 ( r , s ), extrap ) if ( iflag /= 0_ip ) return end do end do ! r -> s kcolr = leftr - kr + 1_ip do s = 1_ip , ks call dbvalu ( tr ( kcolr :), w2 (:, s ),& kr , kr , idr , rval , inbvr , w0 , iflag ,& w1 ( s ), extrap ) if ( iflag /= 0_ip ) return end do ! s kcols = lefts - ks + 1_ip call dbvalu ( ts ( kcols :), w1 , ks , ks , ids , sval , inbvs , w0 , iflag , f , extrap ) end subroutine db6val !***************************************************************************************** !***************************************************************************************** !> ! Checks if the value is withing the range of the knot vectors. ! This is called by the various `db*val` routines. pure function check_value ( x , t , i , extrap ) result ( iflag ) implicit none integer ( ip ) :: iflag !! returns 0 if value is OK, otherwise returns `600+i` real ( wp ), intent ( in ) :: x !! the value to check integer ( ip ), intent ( in ) :: i !! 1=x, 2=y, 3=z, 4=q, 5=r, 6=s real ( wp ), dimension (:), intent ( in ) :: t !! the knot vector logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: allow_extrapolation !! if extrapolation is allowed if ( present ( extrap )) then allow_extrapolation = extrap else allow_extrapolation = . false . end if if ( allow_extrapolation ) then ! in this case all values are OK iflag = 0_ip else if ( x < t ( 1_ip ) . or . x > t ( size ( t , kind = ip ))) then iflag = 600_ip + i ! value out of bounds (601, 602, etc.) else iflag = 0_ip end if end if end function check_value !***************************************************************************************** !***************************************************************************************** !> ! Check the validity of the inputs to the `db*ink` routines. ! Prints warning message if there is an error, ! and also sets iflag and status_ok. ! ! Supports up to 6D: `x`,`y`,`z`,`q`,`r`,`s` ! !### Notes ! ! The code is new, but the logic is based on the original ! logic in the CMLIB routines `db2ink` and `db3ink`. ! !### History ! * Jacob Williams, 2/24/2015 : Created this routine. pure subroutine check_inputs ( iknot ,& iflag ,& nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& x , y , z , q , r , s ,& tx , ty , tz , tq , tr , ts ,& f1 , f2 , f3 , f4 , f5 , f6 ,& bcoef1 , bcoef2 , bcoef3 , bcoef4 , bcoef5 , bcoef6 ,& alt ,& status_ok ) implicit none integer ( ip ), intent ( in ) :: iknot !! = 0 if the `INK` routine is computing the knots. integer ( ip ), intent ( out ) :: iflag integer ( ip ), intent ( in ), optional :: nx , ny , nz , nq , nr , ns integer ( ip ), intent ( in ), optional :: kx , ky , kz , kq , kr , ks real ( wp ), dimension (:), intent ( in ), optional :: x , y , z , q , r , s real ( wp ), dimension (:), intent ( in ), optional :: tx , ty , tz , tq , tr , ts real ( wp ), dimension (:), intent ( in ), optional :: f1 , bcoef1 real ( wp ), dimension (:,:), intent ( in ), optional :: f2 , bcoef2 real ( wp ), dimension (:,:,:), intent ( in ), optional :: f3 , bcoef3 real ( wp ), dimension (:,:,:,:), intent ( in ), optional :: f4 , bcoef4 real ( wp ), dimension (:,:,:,:,:), intent ( in ), optional :: f5 , bcoef5 real ( wp ), dimension (:,:,:,:,:,:), intent ( in ), optional :: f6 , bcoef6 logical , intent ( in ), optional :: alt !! using the alt routine where 1st or !! 2nd deriv is fixed at endpoints !! [default is False] logical , intent ( out ) :: status_ok logical :: error integer :: iex !! extra points for the alt case (in `t` and `bcoef`) !! [currently, only allowed for the 1D case & `k=4`] status_ok = . false . iex = 0_ip ! default if ( present ( alt )) then if ( alt ) iex = 2_ip ! for \"alt\" mode end if if (( iknot < 0_ip ) . or . ( iknot > 1_ip )) then iflag = 2_ip ! iknot is out of range else call check ( 'x' , nx , kx , x , tx ,[ 3_ip , 4_ip , 5_ip , 6_ip , 706_ip , 712_ip ], iflag , error , iex ); if ( error ) return call check ( 'y' , ny , ky , y , ty ,[ 7_ip , 8_ip , 9_ip , 10_ip , 707_ip , 713_ip ], iflag , error , iex ); if ( error ) return call check ( 'z' , nz , kz , z , tz ,[ 11_ip , 12_ip , 13_ip , 14_ip , 708_ip , 714_ip ], iflag , error , iex ); if ( error ) return call check ( 'q' , nq , kq , q , tq ,[ 15_ip , 16_ip , 17_ip , 18_ip , 709_ip , 715_ip ], iflag , error , iex ); if ( error ) return call check ( 'r' , nr , kr , r , tr ,[ 19_ip , 20_ip , 21_ip , 22_ip , 710_ip , 716_ip ], iflag , error , iex ); if ( error ) return call check ( 's' , ns , ks , s , ts ,[ 23_ip , 24_ip , 25_ip , 26_ip , 711_ip , 717_ip ], iflag , error , iex ); if ( error ) return if ( present ( x ) . and . present ( f1 ) . and . present ( bcoef1 )) then if ( size ( x , kind = ip ) /= size ( f1 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef1 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( f2 ) . and . present ( bcoef2 )) then if ( size ( x , kind = ip ) /= size ( f2 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f2 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef2 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef2 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( f3 ) . and . & present ( bcoef3 )) then if ( size ( x , kind = ip ) /= size ( f3 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f3 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f3 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef3 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef3 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef3 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( f4 ) . and . present ( bcoef4 )) then if ( size ( x , kind = ip ) /= size ( f4 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f4 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f4 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f4 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef4 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef4 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef4 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef4 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( f5 ) . and . present ( bcoef5 )) then if ( size ( x , kind = ip ) /= size ( f5 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f5 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f5 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f5 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f5 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef5 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef5 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef5 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef5 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef5 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if end if if ( present ( x ) . and . present ( y ) . and . present ( z ) . and . present ( q ) . and . & present ( r ) . and . present ( s ) . and . present ( f6 ) . and . present ( bcoef6 )) then if ( size ( x , kind = ip ) /= size ( f6 , 1_ip , kind = ip )) then ; iflag = 700_ip ; return ; end if if ( size ( y , kind = ip ) /= size ( f6 , 2_ip , kind = ip )) then ; iflag = 701_ip ; return ; end if if ( size ( z , kind = ip ) /= size ( f6 , 3_ip , kind = ip )) then ; iflag = 702_ip ; return ; end if if ( size ( q , kind = ip ) /= size ( f6 , 4_ip , kind = ip )) then ; iflag = 703_ip ; return ; end if if ( size ( r , kind = ip ) /= size ( f6 , 5_ip , kind = ip )) then ; iflag = 704_ip ; return ; end if if ( size ( s , kind = ip ) /= size ( f6 , 6_ip , kind = ip )) then ; iflag = 705_ip ; return ; end if if ( size ( x , kind = ip ) + iex /= size ( bcoef6 , 1_ip , kind = ip )) then ; iflag = 800_ip ; return ; end if if ( size ( y , kind = ip ) + iex /= size ( bcoef6 , 2_ip , kind = ip )) then ; iflag = 801_ip ; return ; end if if ( size ( z , kind = ip ) + iex /= size ( bcoef6 , 3_ip , kind = ip )) then ; iflag = 802_ip ; return ; end if if ( size ( q , kind = ip ) + iex /= size ( bcoef6 , 4_ip , kind = ip )) then ; iflag = 803_ip ; return ; end if if ( size ( r , kind = ip ) + iex /= size ( bcoef6 , 5_ip , kind = ip )) then ; iflag = 804_ip ; return ; end if if ( size ( s , kind = ip ) + iex /= size ( bcoef6 , 6_ip , kind = ip )) then ; iflag = 805_ip ; return ; end if end if status_ok = . true . iflag = 0_ip end if contains pure subroutine check ( s , n , k , x , t , ierrs , iflag , error , ik ) !! check `t`,`x`,`n`,`k` for validity implicit none character ( len = 1 ), intent ( in ) :: s !! coordinate string: 'x','y','z','q','r','s' integer ( ip ), intent ( in ), optional :: n !! size of `x` integer ( ip ), intent ( in ), optional :: k !! order real ( wp ), dimension (:), intent ( in ), optional :: x !! abcissae vector real ( wp ), dimension (:), intent ( in ), optional :: t !! knot vector `size(n+k)` integer ( ip ), dimension (:), intent ( in ) :: ierrs !! int error codes for `n`,`k`,`x`,`t`, !! `size(x)`,`size(t)` checks integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error !! true if there was an error integer , intent ( in ) :: ik !! add this value to k integer ( ip ), dimension ( 2 ) :: itmp !! temp integer array if ( present ( n ) . and . present ( k ) . and . present ( x ) . and . present ( t )) then itmp = [ ierrs ( 1_ip ), ierrs ( 5 )] call check_n ( 'n' // s , n , x , itmp , iflag , error ); if ( error ) return call check_k ( 'k' // s , k + ik , n , ierrs ( 2 ), iflag , error ); if ( error ) return call check_x ( s , n , x , ierrs ( 3 ), iflag , error ); if ( error ) return if ( iknot /= 0_ip ) then itmp = [ ierrs ( 4 ), ierrs ( 6 )] call check_t ( 't' // s , n , k + ik , t , itmp , iflag , error ); if ( error ) return end if end if end subroutine check pure subroutine check_n ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x !! abcissae vector integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [n<3 check, size(x)==n check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if ( n < 3_ip ) then iflag = ierr ( 1_ip ) error = . true . else if ( size ( x ) /= n ) then iflag = ierr ( 2 ) error = . true . else error = . false . end if end if end subroutine check_n pure subroutine check_k ( s , k , n , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: k integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error if (( k < 2_ip ) . or . ( k >= n )) then iflag = ierr error = . true . else error = . false . end if end subroutine check_k pure subroutine check_x ( s , n , x , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n real ( wp ), dimension (:), intent ( in ) :: x integer ( ip ), intent ( in ) :: ierr integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . do i = 2_ip , n if ( x ( i ) <= x ( i - 1_ip )) then iflag = ierr return end if end do error = . false . end subroutine check_x pure subroutine check_t ( s , n , k , t , ierr , iflag , error ) implicit none character ( len =* ), intent ( in ) :: s integer ( ip ), intent ( in ) :: n integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: t integer ( ip ), dimension ( 2 ), intent ( in ) :: ierr !! [non-decreasing check, size check] integer ( ip ), intent ( out ) :: iflag !! status return code logical , intent ( out ) :: error integer ( ip ) :: i error = . true . if ( size ( t ) /= ( n + k )) then iflag = ierr ( 2 ) return end if if ( iex == 0_ip ) then ! don't do this for \"alt\" mode since they haven't been computed yet do i = 2_ip , n + k if ( t ( i ) < t ( i - 1_ip )) then iflag = ierr ( 1_ip ) return end if end do end if error = . false . end subroutine check_t end subroutine check_inputs !***************************************************************************************** !***************************************************************************************** !> ! dbknot chooses a knot sequence for interpolation of order k at the ! data points x(i), i=1,..,n. the n+k knots are placed in the array ! t. k knots are placed at each endpoint and not-a-knot end ! conditions are used. the remaining knots are placed at data points ! if n is even and between data points if n is odd. the rightmost ! knot is shifted slightly to the right to insure proper interpolation ! at x(n) (see page 350 of the reference). ! !### History ! * Jacob Williams, 2/24/2015 : Refactored this routine. pure subroutine dbknot ( x , n , k , t ) implicit none integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension (:), intent ( out ) :: t integer ( ip ) :: i , j , ipj , npj , ip1 , jstrt real ( wp ) :: rnot !put k knots at each endpoint !(shift right endpoints slightly -- see pg 350 of reference) rnot = x ( n ) + 0.1_wp * ( x ( n ) - x ( n - 1_ip ) ) do j = 1_ip , k t ( j ) = x ( 1_ip ) npj = n + j t ( npj ) = rnot end do !distribute remaining knots if ( mod ( k , 2_ip ) == 1_ip ) then !case of odd k -- knots between data points i = ( k - 1_ip ) / 2_ip - k ip1 = i + 1_ip jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = 0.5_wp * ( x ( ipj ) + x ( ipj + 1_ip ) ) end do else !case of even k -- knots at data points i = ( k / 2_ip ) - k jstrt = k + 1_ip do j = jstrt , n ipj = i + j t ( j ) = x ( ipj ) end do end if end subroutine dbknot !***************************************************************************************** !***************************************************************************************** !> ! dbtpcf computes b-spline interpolation coefficients for nf sets ! of data stored in the columns of the array fcn. the b-spline ! coefficients are stored in the rows of bcoef however. ! each interpolation is based on the n abcissa stored in the ! array x, and the n+k knots stored in the array t. the order ! of each interpolation is k. ! !### History ! * Jacob Williams, 2/24/2015 : Refactored this routine. pure subroutine dbtpcf ( x , n , fcn , ldf , nf , t , k , bcoef , work , iflag ) integer ( ip ), intent ( in ) :: n !! dimension of `x` integer ( ip ), intent ( in ) :: nf integer ( ip ), intent ( in ) :: ldf integer ( ip ), intent ( in ) :: k real ( wp ), dimension (:), intent ( in ) :: x real ( wp ), dimension ( ldf , nf ), intent ( in ) :: fcn real ( wp ), dimension (:), intent ( in ) :: t real ( wp ), dimension ( nf , n ), intent ( out ) :: bcoef real ( wp ), dimension ( * ), intent ( out ) :: work !! work array of size >= `2*k*(n+1)` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 301: n should be >0 integer ( ip ) :: i , j , m1 , m2 , iq , iw ! check for null input if ( nf > 0_ip ) then ! partition work array m1 = k - 1_ip m2 = m1 + k iq = 1_ip + n iw = iq + m2 * n + 1_ip ! compute b-spline coefficients ! first data set call dbintk ( x , fcn , t , n , k , work , work ( iq ), work ( iw ), iflag ) if ( iflag == 0_ip ) then do i = 1_ip , n bcoef ( 1_ip , i ) = work ( i ) end do ! all remaining data sets by back-substitution if ( nf == 1_ip ) return do j = 2_ip , nf do i = 1_ip , n work ( i ) = fcn ( i , j ) end do call dbnslv ( work ( iq ), m2 , n , m1 , m1 , work ) do i = 1_ip , n bcoef ( j , i ) = work ( i ) end do end do end if else !write(error_unit,'(A)') 'dbtpcf - n should be >0' iflag = 301_ip end if end subroutine dbtpcf !***************************************************************************************** !***************************************************************************************** !> ! dbintk produces the b-spline coefficients, bcoef, of the ! b-spline of order k with knots t(i), i=1,...,n+k, which ! takes on the value y(i) at x(i), i=1,...,n. the spline or ! any of its derivatives can be evaluated by calls to [[dbvalu]]. ! ! the i-th equation of the linear system a*bcoef = b for the ! coefficients of the interpolant enforces interpolation at ! x(i), i=1,...,n. hence, b(i) = y(i), for all i, and a is ! a band matrix with 2k-1 bands if a is invertible. the matrix ! a is generated row by row and stored, diagonal by diagonal, ! in the rows of q, with the main diagonal going into row k. ! the banded system is then solved by a call to dbnfac (which ! constructs the triangular factorization for a and stores it ! again in q), followed by a call to dbnslv (which then ! obtains the solution bcoef by substitution). dbnfac does no ! pivoting, since the total positivity of the matrix a makes ! this unnecessary. the linear system to be solved is ! (theoretically) invertible if and only if ! t(i) < x(i) < t(i+k), for all i. ! equality is permitted on the left for i=1 and on the right ! for i=n when k knots are used at x(1) or x(n). otherwise, ! violation of this condition is certain to lead to an error. ! !### Error conditions ! ! * improper input ! * singular system of equations ! !### History ! * splint written by carl de boor [5] ! * dbintk author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * 000330 modified array declarations. (jec) ! * Jacob Williams, 5/10/2015 : converted to free-form Fortran. pure subroutine dbintk ( x , y , t , n , k , bcoef , q , work , iflag ) implicit none integer ( ip ), intent ( in ) :: n !! number of data points, n >= k real ( wp ), dimension ( n ), intent ( in ) :: x !! vector of length n containing data point abscissa !! in strictly increasing order. real ( wp ), dimension ( n ), intent ( in ) :: y !! corresponding vector of length n containing data !! point ordinates. real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length n+k !! since t(1),..,t(k) <= x(1) and t(n+1),..,t(n+k) !! >= x(n), this leaves only n-k knots (not !! necessarily x(i) values) interior to (x(1),x(n)) integer ( ip ), intent ( in ) :: k !! order of the spline, k >= 1 real ( wp ), dimension ( n ), intent ( out ) :: bcoef !! a vector of length n containing the b-spline coefficients real ( wp ), dimension ( * ), intent ( out ) :: q !! a work vector of length (2*k-1)*n, containing !! the triangular factorization of the coefficient !! matrix of the linear system being solved. the !! coefficients for the interpolant of an !! additional data set (x(i),yy(i)), i=1,...,n !! with the same abscissa can be obtained by loading !! yy into bcoef and then executing !! call dbnslv(q,2k-1,n,k-1,k-1,bcoef) real ( wp ), dimension ( * ), intent ( out ) :: work !! work vector of length 2*k integer ( ip ), intent ( out ) :: iflag !! * 0: no errors. !! * 100: k does not satisfy k>=1. !! * 101: n does not satisfy n>=k. !! * 102: x(i) does not satisfy x(i)=1' iflag = 100_ip return end if if ( n < k ) then !write(error_unit,'(A)') 'dbintk - n does not satisfy n>=k' iflag = 101_ip return end if jj = n - 1_ip if ( jj /= 0_ip ) then do i = 1_ip , jj if ( x ( i ) >= x ( i + 1_ip )) then !write(error_unit,'(A)') 'dbintk - x(i) does not satisfy x(i)= ilp1mx ) exit end do if (. not . found ) then left = left - 1_ip if ( xi > t ( left + 1_ip )) then !write(error_unit,'(A)') 'dbintk - some abscissa was not in the support of the'//& ! ' corresponding basis function and the system is singular' iflag = 103_ip return end if end if ! the i-th equation enforces interpolation at xi, hence ! a(i,j) = b(j,k,t)(xi), all j. only the k entries with j = ! left-k+1,...,left actually might be nonzero. these k numbers ! are returned, in bcoef (used for temp.storage here), by the ! following call dbspvn ( t , k , k , 1_ip , xi , left , bcoef , work , iwork , iflag ) if ( iflag /= 0_ip ) return ! we therefore want bcoef(j) = b(left-k+j)(xi) to go into ! a(i,left-k+j), i.e., into q(i-(left+j)+2*k,(left+j)-k) since ! a(i+j,j) is to go into q(i+k,j), all i,j, if we consider q ! as a two-dim. array , with 2*k-1 rows (see comments in ! dbnfac). in the present program, we treat q as an equivalent ! one-dimensional array (because of fortran restrictions on ! dimension statements) . we therefore want bcoef(j) to go into ! entry ! i -(left+j) + 2*k + ((left+j) - k-1)*(2*k-1) ! = i-left+1 + (left -k)*(2*k-1) + (2*k-2)*j ! of q. jj = i - left + 1_ip + ( left - k ) * ( k + km1 ) do j = 1_ip , k jj = jj + kpkm2 q ( jj ) = bcoef ( j ) end do end do ! obtain factorization of a, stored again in q. call dbnfac ( q , k + km1 , n , km1 , km1 , iflag ) if ( iflag == 1 ) then !success ! solve a*bcoef = y by backsubstitution do i = 1_ip , n bcoef ( i ) = y ( i ) end do call dbnslv ( q , k + km1 , n , km1 , km1 , bcoef ) iflag = 0_ip else !failure !write(error_unit,'(A)') 'dbintk - the system of solver detects a singular system'//& ! ' although the theoretical conditions for a solution were satisfied' iflag = 104_ip end if end subroutine dbintk !***************************************************************************************** !***************************************************************************************** !> ! Returns in w the LU-factorization (without pivoting) of the banded ! matrix a of order nrow with (nbandl + 1 + nbandu) bands or diagonals ! in the work array w . ! ! gauss elimination without pivoting is used. the routine is ! intended for use with matrices a which do not require row inter- ! changes during factorization, especially for the totally ! positive matrices which occur in spline calculations. ! the routine should not be used for an arbitrary banded matrix. ! !### Work array ! ! **Input** ! ! w array of size (nroww,nrow) contains the interesting ! part of a banded matrix a , with the diagonals or bands of a ! stored in the rows of w , while columns of a correspond to ! columns of w . this is the storage mode used in linpack and ! results in efficient innermost loops. ! explicitly, a has nbandl bands below the diagonal ! + 1 (main) diagonal ! + nbandu bands above the diagonal ! and thus, with middle = nbandu + 1, ! a(i+j,j) is in w(i+middle,j) for i=-nbandu,...,nbandl ! j=1,...,nrow . ! for example, the interesting entries of a (1,2)-banded matrix ! of order 9 would appear in the first 1+1+2 = 4 rows of w ! as follows. ! 13 24 35 46 57 68 79 ! 12 23 34 45 56 67 78 89 ! 11 22 33 44 55 66 77 88 99 ! 21 32 43 54 65 76 87 98 ! ! all other entries of w not identified in this way with an en- ! try of a are never referenced . ! ! **Output** ! ! * if iflag = 1, then ! w contains the lu-factorization of a into a unit lower triangu- ! lar matrix l and an upper triangular matrix u (both banded) ! and stored in customary fashion over the corresponding entries ! of a . this makes it possible to solve any particular linear ! system a*x = b for x by a ! call dbnslv ( w, nroww, nrow, nbandl, nbandu, b ) ! with the solution x contained in b on return . ! * if iflag = 2, then ! one of nrow-1, nbandl,nbandu failed to be nonnegative, or else ! one of the potential pivots was found to be zero indicating ! that a does not have an lu-factorization. this implies that ! a is singular in case it is totally positive . ! !### History ! * banfac written by carl de boor [5] ! * dbnfac from CMLIB [1] ! * Jacob Williams, 5/10/2015 : converted to free-form Fortran. pure subroutine dbnfac ( w , nroww , nrow , nbandl , nbandu , iflag ) integer ( ip ), intent ( in ) :: nroww !! row dimension of the work array w. must be >= nbandl + 1 + nbandu. integer ( ip ), intent ( in ) :: nrow !! matrix order integer ( ip ), intent ( in ) :: nbandl !! number of bands of a below the main diagonal integer ( ip ), intent ( in ) :: nbandu !! number of bands of a above the main diagonal integer ( ip ), intent ( out ) :: iflag !! indicating success(=1) or failure (=2) real ( wp ), dimension ( nroww , nrow ), intent ( inout ) :: w !! work array. See header for details. integer ( ip ) :: i , ipk , j , jmax , k , kmax , middle , midmk , nrowm1 real ( wp ) :: factor , pivot iflag = 1_ip middle = nbandu + 1_ip ! w(middle,.) contains the main diagonal of a. nrowm1 = nrow - 1_ip if ( nrowm1 < 0_ip ) then iflag = 2_ip return else if ( nrowm1 == 0_ip ) then if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandl <= 0_ip ) then ! a is upper triangular. check that diagonal is nonzero . do i = 1_ip , nrowm1 if ( w ( middle , i ) == 0.0_wp ) then iflag = 2_ip return end if end do if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip return end if if ( nbandu <= 0_ip ) then ! a is lower triangular. check that diagonal is nonzero and ! divide each column by its diagonal. do i = 1_ip , nrowm1 pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do end do return end if ! a is not just a triangular matrix. construct lu factorization do i = 1_ip , nrowm1 ! w(middle,i) is pivot for i-th step . pivot = w ( middle , i ) if ( pivot == 0.0_wp ) then iflag = 2_ip return end if ! jmax is the number of (nonzero) entries in column i ! below the diagonal. jmax = min ( nbandl , nrow - i ) ! divide each entry in column i below diagonal by pivot. do j = 1_ip , jmax w ( middle + j , i ) = w ( middle + j , i ) / pivot end do ! kmax is the number of (nonzero) entries in row i to ! the right of the diagonal. kmax = min ( nbandu , nrow - i ) ! subtract a(i,i+k)*(i-th column) from (i+k)-th column ! (below row i). do k = 1_ip , kmax ipk = i + k midmk = middle - k factor = w ( midmk , ipk ) do j = 1_ip , jmax w ( midmk + j , ipk ) = w ( midmk + j , ipk ) - w ( middle + j , i ) * factor end do end do end do ! check the last diagonal entry. if ( w ( middle , nrow ) == 0.0_wp ) iflag = 2_ip end subroutine dbnfac !***************************************************************************************** !***************************************************************************************** !> ! Companion routine to [[dbnfac]]. it returns the solution x of the ! linear system a*x = b in place of b, given the lu-factorization ! for a in the work array w from dbnfac. ! ! (with a = l*u , as stored in w), the unit lower triangular system ! l(u*x) = b is solved for y = u*x , and y stored in b. then the ! upper triangular system u*x = y is solved for x. the calculations ! are so arranged that the innermost loops stay within columns. ! !### History ! * banslv written by carl de boor [5] ! * dbnslv from SLATEC library [1] ! * Jacob Williams, 5/10/2015 : converted to free-form Fortran. pure subroutine dbnslv ( w , nroww , nrow , nbandl , nbandu , b ) integer ( ip ), intent ( in ) :: nroww !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nrow !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandl !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. integer ( ip ), intent ( in ) :: nbandu !! describes the lu-factorization of a banded matrix a of order `nrow` !! as constructed in [[dbnfac]]. real ( wp ), dimension ( nroww , nrow ), intent ( in ) :: w !! describes the lu-factorization of a banded matrix a of !! order `nrow` as constructed in [[dbnfac]]. real ( wp ), dimension ( nrow ), intent ( inout ) :: b !! * **in**: right side of the system to be solved !! * **out**: the solution x, of order nrow integer ( ip ) :: i , j , jmax , middle , nrowm1 middle = nbandu + 1_ip if ( nrow /= 1_ip ) then nrowm1 = nrow - 1_ip if ( nbandl /= 0_ip ) then ! forward pass ! for i=1,2,...,nrow-1, subtract right side(i)*(i-th column of l) ! from right side (below i-th row). do i = 1_ip , nrowm1 jmax = min ( nbandl , nrow - i ) do j = 1_ip , jmax b ( i + j ) = b ( i + j ) - b ( i ) * w ( middle + j , i ) end do end do end if ! backward pass ! for i=nrow,nrow-1,...,1, divide right side(i) by i-th diagonal ! entry of u, then subtract right side(i)*(i-th column ! of u) from right side (above i-th row). if ( nbandu <= 0_ip ) then ! a is lower triangular. do i = 1_ip , nrow b ( i ) = b ( i ) / w ( 1_ip , i ) end do return end if i = nrow do b ( i ) = b ( i ) / w ( middle , i ) jmax = min ( nbandu , i - 1_ip ) do j = 1_ip , jmax b ( i - j ) = b ( i - j ) - b ( i ) * w ( middle - j , i ) end do i = i - 1_ip if ( i <= 1_ip ) exit end do end if b ( 1_ip ) = b ( 1_ip ) / w ( middle , 1_ip ) end subroutine dbnslv !***************************************************************************************** !***************************************************************************************** !> ! Calculates the value of all (possibly) nonzero basis ! functions at x of order max(jhigh,(j+1)*(index-1)), where t(k) ! <= x <= t(n+1) and j=iwork is set inside the routine on ! the first call when index=1. ileft is such that t(ileft) <= ! x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag) ! produces the proper ileft. dbspvn calculates using the basic ! algorithm needed in dbspvd. if only basis functions are ! desired, setting jhigh=k and index=1 can be faster than ! calling dbspvd, but extra coding is required for derivatives ! (index=2) and dbspvd is set up for this purpose. ! ! left limiting values are set up as described in dbspvd. ! !### Error Conditions ! ! * improper input ! !### History ! * bsplvn written by carl de boor [5] ! * dbspvn author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * 000330 modified array declarations. (jec) ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine dbspvn ( t , jhigh , k , index , x , ileft , vnikx , work , iwork , iflag ) implicit none real ( wp ), dimension ( * ), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-`k` !! dimension `t(ileft+jhigh)` integer ( ip ), intent ( in ) :: jhigh !! order of b-spline, `1 <= jhigh <= k` integer ( ip ), intent ( in ) :: k !! highest possible order integer ( ip ), intent ( in ) :: index !! index = 1 gives basis functions of order `jhigh` !! = 2 denotes previous entry with `work`, `iwork` !! values saved for subsequent calls to !! dbspvn. real ( wp ), intent ( in ) :: x !! argument of basis functions, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that `t(ileft) <= x < t(ileft+1)` real ( wp ), dimension ( k ), intent ( out ) :: vnikx !! vector of length `k` for spline values. real ( wp ), dimension ( * ), intent ( inout ) :: work !! a work vector of length `2*k` integer ( ip ), intent ( inout ) :: iwork !! a work parameter. both `work` and `iwork` contain !! information necessary to continue for `index = 2`. !! when `index = 1` exclusively, these are scratch !! variables and can be used for other purposes. integer ( ip ), intent ( out ) :: iflag !! * 0: no errors !! * 201: `k` does not satisfy `k>=1` !! * 202: `jhigh` does not satisfy `1<=jhigh<=k` !! * 203: `index` is not 1 or 2 !! * 204: `x` does not satisfy `t(ileft)<=x<=t(ileft+1)` integer ( ip ) :: imjp1 , ipj , jp1 , jp1ml , l real ( wp ) :: vm , vmprev ! content of j, deltam, deltap is expected unchanged between calls. ! work(i) = deltap(i), ! work(k+i) = deltam(i), i = 1,k if ( k < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - k does not satisfy k>=1' iflag = 201_ip return end if if ( jhigh > k . or . jhigh < 1_ip ) then !write(error_unit,'(A)') 'dbspvn - jhigh does not satisfy 1<=jhigh<=k' iflag = 202_ip return end if if ( index < 1_ip . or . index > 2_ip ) then !write(error_unit,'(A)') 'dbspvn - index is not 1 or 2' iflag = 203_ip return end if if ( x < t ( ileft ) . or . x > t ( ileft + 1_ip )) then !write(error_unit,'(A)') 'dbspvn - x does not satisfy t(ileft)<=x<=t(ileft+1)' iflag = 204_ip return end if iflag = 0_ip if ( index == 1_ip ) then iwork = 1_ip vnikx ( 1_ip ) = 1.0_wp if ( iwork >= jhigh ) return end if do ipj = ileft + iwork work ( iwork ) = t ( ipj ) - x imjp1 = ileft - iwork + 1_ip work ( k + iwork ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = iwork + 1_ip do l = 1_ip , iwork jp1ml = jp1 - l vm = vnikx ( l ) / ( work ( l ) + work ( k + jp1ml )) vnikx ( l ) = vm * work ( l ) + vmprev vmprev = vm * work ( k + jp1ml ) end do vnikx ( jp1 ) = vmprev iwork = jp1 if ( iwork >= jhigh ) exit end do end subroutine dbspvn !***************************************************************************************** !***************************************************************************************** !> ! Evaluates the b-representation (`t`,`a`,`n`,`k`) of a b-spline ! at `x` for the function value on `ideriv=0` or any of its ! derivatives on `ideriv=1,2,...,k-1`. right limiting values ! (right derivatives) are returned except at the right end ! point `x=t(n+1)` where left limiting values are computed. the ! spline is defined on `t(k)` \\le `x` \\le `t(n+1)`. ! dbvalu returns a fatal error message when `x` is outside of this ! interval. ! ! To compute left derivatives or left limiting values at a ! knot `t(i)`, replace `n` by `i-1` and set `x=t(i), i=k+1,n+1`. ! !### Error Conditions ! ! * improper input ! !### History ! * bvalue written by carl de boor [5] ! * dbvalu author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * 000330 modified array declarations. (jec) ! * Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine. pure subroutine dbvalu ( t , a , n , k , ideriv , x , inbv , work , iflag , val , extrap ) implicit none real ( wp ), intent ( out ) :: val !! the interpolated value integer ( ip ), intent ( in ) :: n !! number of b-spline coefficients. !! (sum of knot multiplicities-`k`) real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k` real ( wp ), dimension ( n ), intent ( in ) :: a !! b-spline coefficient vector of length `n` integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: ideriv !! order of the derivative, `0 <= ideriv <= k-1`. !! `ideriv = 0` returns the b-spline value real ( wp ), intent ( in ) :: x !! argument, `t(k) <= x <= t(n+1)` integer ( ip ), intent ( inout ) :: inbv !! an initialization parameter which must be set !! to 1 the first time [[dbvalu]] is called. !! `inbv` contains information for efficient processing !! after the initial call and `inbv` must not !! be changed by the user. distinct splines require !! distinct `inbv` parameters. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length at least `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 401: `k` does not satisfy `k` \\ge 1 !! * 402: `n` does not satisfy `n` \\ge `k` !! * 403: `ideriv` does not satisfy 0 \\le `ideriv` < `k` !! * 404: `x` is not greater than or equal to `t(k)` !! * 405: `x` is not less than or equal to `t(n+1)` !! * 406: a left limiting value cannot be obtained at `t(k)` logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: i , iderp1 , ihi , ihmkmj , ilo , imk , imkpj , ipj ,& ip1 , ip1mj , j , jj , j1 , j2 , kmider , kmj , km1 , kpk , mflag real ( wp ) :: fkmj real ( wp ) :: xt logical :: extrapolation_allowed !! if extrapolation is allowed val = 0.0_wp if ( k < 1_ip ) then iflag = 401_ip ! dbvalu - k does not satisfy k>=1 return end if if ( n < k ) then iflag = 402_ip ! dbvalu - n does not satisfy n>=k return end if if ( ideriv < 0_ip . or . ideriv >= k ) then iflag = 403_ip ! dbvalu - ideriv does not satisfy 0<=ideriv t ( n + 1_ip )) then xt = t ( n + 1_ip ) else xt = x end if else xt = x end if kmider = k - ideriv ! find *i* in (k,n) such that t(i) <= x < t(i+1) ! (or, <= t(i+1) if t(i) < t(i+1) = t(n+1)). km1 = k - 1_ip call dintrv ( t , n + 1 , xt , inbv , i , mflag ) if ( xt < t ( k )) then iflag = 404_ip ! dbvalu - x is not greater than or equal to t(k) return end if if ( mflag /= 0_ip ) then if ( xt > t ( i )) then iflag = 405_ip ! dbvalu - x is not less than or equal to t(n+1) return end if do if ( i == k ) then iflag = 406_ip ! dbvalu - a left limiting value cannot be obtained at t(k) return end if i = i - 1_ip if ( xt /= t ( i )) exit end do end if ! difference the coefficients *ideriv* times ! work(i) = aj(i), work(k+i) = dp(i), work(k+k+i) = dm(i), i=1.k imk = i - k do j = 1_ip , k imkpj = imk + j work ( j ) = a ( imkpj ) end do if ( ideriv /= 0_ip ) then do j = 1_ip , ideriv kmj = k - j fkmj = real ( kmj , wp ) do jj = 1_ip , kmj ihi = i + jj ihmkmj = ihi - kmj work ( jj ) = ( work ( jj + 1_ip ) - work ( jj )) / ( t ( ihi ) - t ( ihmkmj )) * fkmj end do end do end if ! compute value at *x* in (t(i),(t(i+1)) of ideriv-th derivative, ! given its relevant b-spline coeff. in aj(1),...,aj(k-ideriv). if ( ideriv /= km1 ) then ip1 = i + 1_ip kpk = k + k j1 = k + 1_ip j2 = kpk + 1_ip do j = 1_ip , kmider ipj = i + j work ( j1 ) = t ( ipj ) - x ip1mj = ip1 - j work ( j2 ) = x - t ( ip1mj ) j1 = j1 + 1_ip j2 = j2 + 1_ip end do iderp1 = ideriv + 1_ip do j = iderp1 , km1 kmj = k - j ilo = kmj do jj = 1_ip , kmj work ( jj ) = ( work ( jj + 1_ip ) * work ( kpk + ilo ) + work ( jj ) * & work ( k + jj )) / ( work ( kpk + ilo ) + work ( k + jj )) ilo = ilo - 1 end do end do end if iflag = 0_ip val = work ( 1_ip ) end subroutine dbvalu !***************************************************************************************** !***************************************************************************************** !> ! Computes the largest integer `ileft` in 1 \\le `ileft` \\le `lxt` ! such that `xt(ileft)` \\le `x` where `xt(*)` is a subdivision of ! the `x` interval. ! precisely, ! !```fortran ! if x < xt(1) then ileft=1, mflag=-1 ! if xt(i) <= x < xt(i+1) then ileft=i, mflag=0 ! if xt(lxt) <= x then ileft=lxt, mflag=-2 !``` ! ! that is, when multiplicities are present in the break point ! to the left of `x`, the largest index is taken for `ileft`. ! !### History ! * interv written by carl de boor [5] ! * dintrv author: amos, d. e., (snla) : date written 800901 ! * revision date 820801 ! * Jacob Williams, 2/24/2015 : updated to free-form Fortran. ! * Jacob Williams, 2/17/2016 : additional refactoring (eliminated GOTOs). ! * Jacob Williams, 3/4/2017 : added extrapolation option. pure subroutine dintrv ( xt , lxt , xx , ilo , ileft , mflag , extrap ) implicit none integer ( ip ), intent ( in ) :: lxt !! length of the `xt` vector real ( wp ), dimension (:), intent ( in ) :: xt !! a knot or break point vector of length `lxt` real ( wp ), intent ( in ) :: xx !! argument integer ( ip ), intent ( inout ) :: ilo !! an initialization parameter which must be set !! to 1 the first time the spline array `xt` is !! processed by dintrv. `ilo` contains information for !! efficient processing after the initial call and `ilo` !! must not be changed by the user. distinct splines !! require distinct `ilo` parameters. integer ( ip ), intent ( out ) :: ileft !! largest integer satisfying `xt(ileft)` \\le `x` integer ( ip ), intent ( out ) :: mflag !! signals when `x` lies out of bounds logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) integer ( ip ) :: ihi , istep , middle real ( wp ) :: x x = get_temp_x_for_extrap ( xx , xt ( 1_ip ), xt ( lxt ), extrap ) ihi = ilo + 1_ip if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if if ( lxt <= 1 ) then mflag = - 1_ip ileft = 1_ip return end if ilo = lxt - 1_ip ihi = lxt end if if ( x >= xt ( ihi ) ) then ! now x >= xt(ilo). find upper bound istep = 1_ip do ilo = ihi ihi = ilo + istep if ( ihi >= lxt ) then if ( x >= xt ( lxt ) ) then mflag = - 2_ip ileft = lxt return end if ihi = lxt else if ( x >= xt ( ihi ) ) then istep = istep * 2_ip cycle end if exit end do else if ( x >= xt ( ilo ) ) then mflag = 0_ip ileft = ilo return end if ! now x <= xt(ihi). find lower bound istep = 1_ip do ihi = ilo ilo = ihi - istep if ( ilo <= 1_ip ) then ilo = 1_ip if ( x < xt ( 1_ip ) ) then mflag = - 1_ip ileft = 1_ip return end if else if ( x < xt ( ilo ) ) then istep = istep * 2_ip cycle end if exit end do end if ! now xt(ilo) <= x < xt(ihi). narrow the interval do middle = ( ilo + ihi ) / 2_ip if ( middle == ilo ) then mflag = 0_ip ileft = ilo return end if ! note. it is assumed that middle = ilo in case ihi = ilo+1 if ( x < xt ( middle ) ) then ihi = middle else ilo = middle end if end do end subroutine dintrv !***************************************************************************************** !***************************************************************************************** !> ! DBINT4 computes the B representation (`t`,`bcoef`,`n`,`k`) of a ! cubic spline (`k=4`) which interpolates data (`x(i)`,`y(i)`),`i=1,ndata`. ! ! Parameters `ibcl`, `ibcr`, `fbcl`, `fbcr` allow the specification of the spline ! first or second derivative at both `x(1)` and `x(ndata)`. When this data is not specified ! by the problem, it is common practice to use a natural spline by setting second ! derivatives at `x(1)` and `x(ndata)` to zero (`ibcl=ibcr=2`,`fbcl=fbcr=0.0`). ! ! The spline is defined on `t(4) <= x <= t(n+1)` with (ordered) interior knots at ! `x(i)` values where n=ndata+2. The knots `t(1)`,`t(2)`,`t(3)` lie to the left of ! `t(4)=x(1)` and the knots `t(n+2)`, `t(n+3)`, `t(n+4)` lie to the right of `t(n+1)=x(ndata)` ! in increasing order. ! ! * If no extrapolation outside (`x(1)`,`x(ndata)`) is anticipated, the ! knots `t(1)=t(2)=t(3)=t(4)=x(1)` and `t(n+2)=t(n+3)=t(n+4)=t(n+1)=x(ndata)` ! can be specified by `kntopt=1`. ! * `kntopt=2` selects a knot placement for `t(1)`, `t(2)`, `t(3)` to make the ! first 7 knots symmetric about `t(4)=x(1)` and similarly for ! `t(n+2)`, `t(n+3)`, `t(n+4)` about `t(n+1)=x(ndata)`. ! * `kntopt=3` allows the user to make his own selection, in increasing order, ! for `t(1)`, `t(2)`, `t(3)` to the left of `x(1)` and `t(n+2)`, `t(n+3)`, `t(n+4)` to ! the right of x(ndata). ! ! In any case, the interpolation on `t(4) <= x <= t(n+1)` ! by using function [[dbvalu]] is unique for given boundary ! conditions. ! !### Error conditions ! * improper input ! * singular system of equations ! !### See also ! * [[dbintk]] ! !### History ! * Written by D. E. Amos (SNLA), August, 1979. ! * date written 800901 ! * revision date 820801 ! * 000330 Modified array declarations. (JEC) ! * Jacob Williams, 8/30/2018 : refactored to modern Fortran. pure subroutine dbint4 ( x , y , ndata , ibcl , ibcr , fbcl , fbcr , kntopt , tleft , tright , t , bcoef , n , k , w , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: x !! x vector of abscissae of length `ndata`, distinct !! and in increasing order real ( wp ), dimension (:), intent ( in ) :: y !! y vector of ordinates of length ndata integer ( ip ), intent ( in ) :: ndata !! number of data points, `ndata >= 2` integer ( ip ), intent ( in ) :: ibcl !! selection parameter for left boundary condition: !! !! * `ibcl = 1` constrain the first derivative at `x(1)` to `fbcl` !! * `ibcl = 2` constrain the second derivative at `x(1)` to `fbcl` integer ( ip ), intent ( in ) :: ibcr !! selection parameter for right boundary condition: !! !! * `ibcr = 1` constrain first derivative at `x(ndata)` to `fbcr` !! * `ibcr = 2` constrain second derivative at `x(ndata)` to `fbcr` real ( wp ), intent ( in ) :: fbcl !! left boundary values governed by `ibcl` real ( wp ), intent ( in ) :: fbcr !! right boundary values governed by `ibcr` integer ( ip ), intent ( in ) :: kntopt !! knot selection parameter: !! !! * `kntopt = 1` sets knot multiplicity at `t(4)` and !! `t(n+1)` to 4 !! * `kntopt = 2` sets a symmetric placement of knots !! about `t(4)` and `t(n+1)` !! * `kntopt = 3` sets `t(i)=tleft(i)` and !! `t(n+1+i)=tright(i)`,`i=1,3` real ( wp ), dimension ( 3 ), intent ( in ) :: tleft !! when `kntopt = 3`: `t(1:3)` in increasing !! order to be supplied by the user. real ( wp ), dimension ( 3 ), intent ( in ) :: tright !! when `kntopt = 3`: `t(n+2:n+4)` in increasing !! order to be supplied by the user. real ( wp ), dimension (:), intent ( out ) :: t !! knot array of length `n+4` real ( wp ), dimension (:), intent ( out ) :: bcoef !! b spline coefficient array of length `n` integer ( ip ), intent ( out ) :: n !! number of coefficients, `n=ndata+2` integer ( ip ), intent ( out ) :: k !! order of spline, `k=4` real ( wp ), dimension ( 5 , ndata + 2 ), intent ( inout ) :: w !! work array integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 2001: `ndata` is less than 2 !! * 2002: `x` values are not distinct or not ordered !! * 2003: `ibcl` is not 1 or 2 !! * 2004: `ibcr` is not 1 or 2 !! * 2005: `kntopt` is not 1, 2, or 3 !! * 2006: knot input through `tleft`, `tright` is !! not ordered properly !! * 2007: the system of equations is singular integer ( ip ) :: i , ilb , ileft , it , iub , iw , iwp , j , jw , ndm , np , nwrow real ( wp ) :: txn , tx1 , xl real ( wp ), dimension ( 4 , 4 ) :: vnikx real ( wp ), dimension ( 15 ) :: work !! work array for [[dbspvd]] -- length `(k+1)*(k+2)/2` real ( wp ), parameter :: wdtol = epsilon ( 1.0_wp ) !! d1mach(4) real ( wp ), parameter :: tol = sqrt ( wdtol ) if ( ndata < 2_ip ) then iflag = 2001_ip ! ndata is less than 2 return end if ndm = ndata - 1_ip do i = 1_ip , ndm if ( x ( i ) >= x ( i + 1_ip )) then iflag = 2002_ip ! x values are not distinct or not ordered return end if end do if ( ibcl < 1_ip . or . ibcl > 2_ip ) then iflag = 2003_ip ! ibcl is not 1 or 2 return end if if ( ibcr < 1_ip . or . ibcr > 2_ip ) then iflag = 2004_ip ! ibcr is not 1 or 2 return end if if ( kntopt < 1_ip . or . kntopt > 3_ip ) then iflag = 2005_ip ! kntopt is not 1, 2, or 3 return end if iflag = 0_ip k = 4_ip n = ndata + 2_ip np = n + 1_ip do i = 1_ip , ndata t ( i + 3 ) = x ( i ) end do select case ( kntopt ) case ( 1_ip ) ! set up knot array with multiplicity 4 at x(1) and x(ndata) do i = 1 , 3_ip t ( 4 - i ) = x ( 1 ) t ( np + i ) = x ( ndata ) end do case ( 2_ip ) !set up knot array with symmetric placement about end points if ( ndata > 3 ) then tx1 = x ( 1 ) + x ( 1 ) txn = x ( ndata ) + x ( ndata ) do i = 1 , 3 t ( 4 - i ) = tx1 - x ( i + 1 ) t ( np + i ) = txn - x ( ndata - i ) end do else xl = ( x ( ndata ) - x ( 1 )) / 3.0_wp do i = 1 , 3 t ( 4 - i ) = t ( 5 - i ) - xl t ( np + i ) = t ( np + i - 1 ) + xl end do end if case ( 3 ) ! set up knot array less than x(1) and greater than x(ndata) to be ! supplied by user in tleft & tright when kntopt=3 t ( 1 : 3 ) = tleft t ( ndata + 4 : ndata + 6 ) = tright do i = 1 , 3 if (( t ( 4 - i ) > t ( 5 - i )) . or . ( t ( np + i ) < t ( np + i - 1 ))) then iflag = 2006_ip ! knot input through tleft, tright is not ordered properly return end if end do end select w = 0.0_wp ! set up left interpolation point and left boundary condition for ! right limits it = ibcl + 1 call dbspvd ( t , k , it , x ( 1 ), k , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check iw = 0_ip if ( abs ( vnikx ( 3 , 1 )) < tol ) iw = 1_ip do j = 1 , 3 w ( j + 1 , 4 - j ) = vnikx ( 4 - j , it ) w ( j , 4 - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( 1 ) = y ( 1 ) bcoef ( 2 ) = fbcl ! set up interpolation equations for points i=2 to i=ndata-1 ileft = 4_ip if ( ndm >= 2 ) then do i = 2 , ndm ileft = ileft + 1_ip call dbspvd ( t , k , 1_ip , x ( i ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check do j = 1 , 3 w ( j + 1 , 3 + i - j ) = vnikx ( 4 - j , 1 ) end do bcoef ( i + 1 ) = y ( i ) end do end if ! set up right interpolation point and right boundary condition for ! left limits(ileft is associated with t(n)=x(ndata-1)) it = ibcr + 1_ip call dbspvd ( t , k , it , x ( ndata ), ileft , 4_ip , vnikx , work , iflag ) if ( iflag /= 0_ip ) return ! error check jw = 0_ip if ( abs ( vnikx ( 2 , 1 )) < tol ) jw = 1_ip do j = 1 , 3 w ( j + 1 , 3 + ndata - j ) = vnikx ( 5 - j , it ) w ( j + 2 , 3 + ndata - j ) = vnikx ( 5 - j , 1 ) end do bcoef ( n - 1 ) = fbcr bcoef ( n ) = y ( ndata ) ! solve system of equations ilb = 2_ip - jw iub = 2_ip - iw nwrow = 5_ip iwp = iw + 1_ip call dbnfac ( w ( iwp , 1 ), nwrow , n , ilb , iub , iflag ) if ( iflag == 2_ip ) then iflag = 2007_ip ! the system of equations is singular else iflag = 0_ip ! success call dbnslv ( w ( iwp , 1 ), nwrow , n , ilb , iub , bcoef ) end if end subroutine dbint4 !***************************************************************************************** !***************************************************************************************** !> ! DBSPVD calculates the value and all derivatives of order ! less than `nderiv` of all basis functions which do not ! (possibly) vanish at `x`. `ileft` is input such that ! `t(ileft) <= x < t(ileft+1)`. A call to [[dintrv]](`t`,`n+1`,`x`, ! `ilo`,`ileft`,`mflag`) will produce the proper `ileft`. The output of ! dbspvd is a matrix `vnikx(i,j)` of dimension at least `(k,nderiv)` ! whose columns contain the `k` nonzero basis functions and ! their `nderiv-1` right derivatives at `x`, `i=1,k, j=1,nderiv`. ! These basis functions have indices `ileft-k+i`, `i=1,k, ! k <= ileft <= n`. The nonzero part of the `i`-th basis ! function lies in `(t(i),t(i+k)), i=1,n)`. ! ! If `x=t(ileft+1)` then `vnikx` contains left limiting values ! (left derivatives) at `t(ileft+1)`. In particular, `ileft = n` ! produces left limiting values at the right end point ! `x=t(n+1)`. To obtain left limiting values at `t(i)`, `i=k+1,n+1`, ! set `x` = next lower distinct knot, call [[dintrv]] to get `ileft`, ! set `x=t(i)`, and then call dbspvd. ! !### History ! * Written by Carl de Boor and modified by D. E. Amos ! * date written 800901 ! * revision date 820801 ! * 000330 Modified array declarations. (JEC) ! * Jacob Williams, 8/30/2018 : refactored to modern Fortran. ! !@note `DBSPVD` is the `BSPLVD` routine of the reference. pure subroutine dbspvd ( t , k , nderiv , x , ileft , ldvnik , vnikx , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot vector of length `n+k`, where !! `n` = number of b-spline basis functions !! `n` = sum of knot multiplicities-k integer ( ip ), intent ( in ) :: k !! order of the b-spline, `k >= 1` integer ( ip ), intent ( in ) :: nderiv !! number of derivatives = `nderiv-1`, !! `1 <= nderiv <= k` real ( wp ), intent ( in ) :: x !! argument of basis functions, !! `t(k) <= x <= t(n+1)` integer ( ip ), intent ( in ) :: ileft !! largest integer such that !! `t(ileft) <= x < t(ileft+1)` integer ( ip ), intent ( in ) :: ldvnik !! leading dimension of matrix `vnikx` real ( wp ), dimension ( ldvnik , nderiv ), intent ( out ) :: vnikx !! matrix of dimension at least `(k,nderiv)` !! containing the nonzero basis functions !! at `x` and their derivatives columnwise. real ( wp ), dimension ( * ), intent ( out ) :: work !! a work vector of length `(k+1)*(k+2)/2` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 3001: `k` does not satisfy `k>=1` !! * 3002: `nderiv` does not satisfy `1<=nderiv<=k` !! * 3003: `ldvnik` does not satisfy `ldvnik>=k` integer ( ip ) :: i , ideriv , ipkmd , j , jj , jlow , jm , jp1mid , kmd , kp1 , l , ldummy , m , mhigh , iwork real ( wp ) :: factor , fkmd , v ! dimension t(ileft+k), work((k+1)*(k+2)/2) ! a(i,j) = work(i+j*(j+1)/2), i=1,j+1 j=1,k-1 ! a(i,k) = work(i+k*(k-1)/2) i=1.k ! work(1) and work((k+1)*(k+2)/2) are not used. if ( k < 1 ) then iflag = 3001_ip ! k does not satisfy k>=1 return end if if ( nderiv < 1 . or . nderiv > k ) then iflag = 3002_ip ! nderiv does not satisfy 1<=nderiv<=k return end if if ( ldvnik < k ) then iflag = 3003_ip ! ldvnik does not satisfy ldvnik>=k return end if iflag = 0_ip ideriv = nderiv kp1 = k + 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 1_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 . or . ideriv == 1 ) return mhigh = ideriv do m = 2 , mhigh jp1mid = 1 do j = ideriv , k vnikx ( j , ideriv ) = vnikx ( jp1mid , 1 ) jp1mid = jp1mid + 1 end do ideriv = ideriv - 1 jj = kp1 - ideriv call dbspvn ( t , jj , k , 2_ip , x , ileft , vnikx , work , iwork , iflag ) if ( iflag /= 0 ) return end do jm = kp1 * ( kp1 + 1 ) / 2 do l = 1 , jm work ( l ) = 0.0_wp end do ! a(i,i) = work(i*(i+3)/2) = 1.0 i = 1,k l = 2 j = 0 do i = 1 , k j = j + l work ( j ) = 1.0_wp l = l + 1 end do kmd = k do m = 2 , mhigh kmd = kmd - 1 fkmd = real ( kmd , wp ) i = ileft j = k jj = j * ( j + 1 ) / 2 jm = jj - j do ldummy = 1 , kmd ipkmd = i + kmd factor = fkmd / ( t ( ipkmd ) - t ( i )) do l = 1 , j work ( l + jj ) = ( work ( l + jj ) - work ( l + jm )) * factor end do i = i - 1 j = j - 1 jj = jm jm = jm - j end do do i = 1 , k v = 0.0_wp jlow = max ( i , m ) jj = jlow * ( jlow + 1 ) / 2 do j = jlow , k v = work ( i + jj ) * vnikx ( j , m ) + v jj = jj + j + 1 end do vnikx ( i , m ) = v end do end do end subroutine dbspvd !***************************************************************************************** !***************************************************************************************** !> ! DBSQAD computes the integral on `(x1,x2)` of a `k`-th order ! b-spline using the b-representation `(t,bcoef,n,k)`. orders ! `k` as high as 20 are permitted by applying a 2, 6, or 10 ! point gauss formula on subintervals of `(x1,x2)` which are ! formed by included (distinct) knots. ! ! If orders `k` greater than 20 are needed, use [[dbfqad]] with ! `f(x) = 1`. ! !### Note ! * The maximum number of significant digits obtainable in ! DBSQAD is the smaller of ~300 and the number of digits ! carried in `real(wp)` arithmetic. ! !### References ! * D. E. Amos, \"Quadrature subroutines for splines and ! B-splines\", Report SAND79-1825, Sandia Laboratories, ! December 1979. ! !### History ! * Author: Amos, D. E., (SNLA) ! * 800901 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890531 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900326 Removed duplicate information from DESCRIPTION section. (WRB) ! * 920501 Reformatted the REFERENCES section. (WRB) ! * Jacob Williams, 9/6/2017 : refactored to modern Fortran. ! Added higher precision coefficients. ! !@note Extrapolation is not enabled for this routine. pure subroutine dbsqad ( t , bcoef , n , k , x1 , x2 , bquad , work , iflag ) implicit none real ( wp ), dimension (:), intent ( in ) :: t !! knot array of length `n+k` real ( wp ), dimension (:), intent ( in ) :: bcoef !! b-spline coefficient array of length `n` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `1 <= k <= 20` real ( wp ), intent ( in ) :: x1 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! end point of quadrature interval !! in `t(k) <= x <= t(n+1)` real ( wp ), intent ( out ) :: bquad !! integral of the b-spline over (`x1`,`x2`) real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 901: `k` does not satisfy `1<=k<=20` !! * 902: `n` does not satisfy `n>=k` !! * 903: `x1` or `x2` or both do !! not satisfy `t(k)<=x<=t(n+1)` integer ( ip ) :: i , il1 , il2 , ilo , inbv , jf , left , m , mf , mflag , npk , np1 real ( wp ) :: a , aa , b , bb , bma , bpa , c1 , gx , q , ta , tb , y1 , y2 real ( wp ), dimension ( 5 ) :: s !! sum real ( wp ), dimension ( 9 ), parameter :: gpts = [ & & 0.577350269189625764509148780501957455647601751270126876018602326483977 & & 67230293334569371539558574952522520871380513556767665664836499965082627 & & 05518373647912161760310773007685273559916067003615583077550051041144223 & & 01107628883557418222973945990409015710553455953862673016662179126619796 & & 4892168_wp ,& & 0.238619186083196908630501721680711935418610630140021350181395164574274 & & 93427563984224922442725734913160907222309701068720295545303507720513526 & & 28872175189982985139866216812636229030578298770859440976999298617585739 & & 46921613621659222233462641640013936777894532787145324672151888999339900 & & 0945406150514997832_wp ,& & 0.661209386466264513661399595019905347006448564395170070814526705852183 & & 49660714310094428640374646145642988837163927514667955734677222538043817 & & 23198010093367423918538864300079016299442625145884902455718821970386303 & & 22362011735232135702218793618906974301231555871064213101639896769013566 & & 1651261150514997832_wp ,& & 0.932469514203152027812301554493994609134765737712289824872549616526613 & & 50084420019627628873992192598504786367972657283410658797137951163840419 & & 21786180750210169211578452038930846310372961174632524612619760497437974 & & 07422632089671621172178385230505104744277222209386367655366917903888025 & & 2326771150514997832_wp ,& & 0.148874338981631210884826001129719984617564859420691695707989253515903 & & 61735566852137117762979946369123003116080525533882610289018186437654023 & & 16761969968090913050737827720371059070942475859422743249837177174247346 & & 21691485290294292900319346665908243383809435507599683357023000500383728 & & 0634351_wp ,& & 0.433395394129247190799265943165784162200071837656246496502701513143766 & & 98907770350122510275795011772122368293504099893794727422475772324920512 & & 67741032822086200952319270933462032011328320387691584063411149801129823 & & 14148878744320432476641442157678880770848387945248811854979703928792696 & & 4254222_wp ,& & 0.679409568299024406234327365114873575769294711834809467664817188952558 & & 57539507492461507857357048037949983390204739931506083674084257663009076 & & 82741718202923543197852846977409718369143712013552962837733153108679126 & & 93254495485472934132472721168027426848661712101171203022718105101071880 & & 4444161_wp ,& & 0.865063366688984510732096688423493048527543014965330452521959731845374 & & 75513805556135679072894604577069440463108641176516867830016149345356373 & & 92729396890950011571349689893051612072435760480900979725923317923795535 & & 73929059587977695683242770223694276591148364371481692378170157259728913 & & 9322313_wp ,& & 0.973906528517171720077964012084452053428269946692382119231212066696595 & & 20323463615962572356495626855625823304251877421121502216860143447777992 & & 05409587259942436704413695764881258799146633143510758737119877875210567 & & 06745243536871368303386090938831164665358170712568697066873725922944928 & & 4383797_wp ] real ( wp ), dimension ( 9 ), parameter :: gwts = [ & & 1.0_wp ,& & 0.467913934572691047389870343989550994811655605769210535311625319963914 & & 20162039812703111009258479198230476626878975479710092836255417350295459 & & 35635592733866593364825926382559018030281273563502536241704619318259000 & & 99756987095900533474080074634376824431808173206369174103416261765346292 & & 7888917150514997832_wp ,& & 0.360761573048138607569833513837716111661521892746745482289739240237140 & & 03783726171832096220198881934794311720914037079858987989027836432107077 & & 67872114085818922114502722525757771126000732368828591631602895111800517 & & 40813685547074482472486101183259931449817216402425586777526768199930950 & & 3106873150514997832_wp ,& & 0.171324492379170345040296142172732893526822501484043982398635439798945 & & 76054234015464792770542638866975211652206987440430919174716746217597462 & & 96492293180314484520671351091683210843717994067668872126692485569940481 & & 59429327357024984053433824182363244118374610391205239119044219703570297 & & 7497812150514997832_wp ,& & 0.295524224714752870173892994651338329421046717026853601354308029755995 & & 93821715232927035659579375421672271716440125255838681849078955200582600 & & 19363424941869666095627186488841680432313050615358674090830512706638652 & & 87483901746874726597515954450775158914556548308329986393605934912382356 & & 670244_wp ,& & 0.269266719309996355091226921569469352859759938460883795800563276242153 & & 43231917927676422663670925276075559581145036869830869292346938114524155 & & 64658846634423711656014432259960141729044528030344411297902977067142537 & & 53480628460839927657500691168674984281408628886853320804215041950888191 & & 6391898_wp ,& & 0.219086362515982043995534934228163192458771870522677089880956543635199 & & 91065295128124268399317720219278659121687281288763476662690806694756883 & & 09211843316656677105269915322077536772652826671027878246851010208832173 & & 32006427348325475625066841588534942071161341022729156547776892831330068 & & 8702802_wp ,& & 0.149451349150580593145776339657697332402556639669427367835477268753238 & & 65472663001094594726463473195191400575256104543633823445170674549760147 & & 13716011937109528798134828865118770953566439639333773939909201690204649 & & 08381561877915752257830034342778536175692764212879241228297015017259084 & & 2897331_wp ,& & 0.066671344308688137593568809893331792857864834320158145128694881613412 & & 06408408710177678550968505887782109005471452041933148750712625440376213 & & 93049873169940416344953637064001870112423155043935262424506298327181987 & & 18647480566044117862086478449236378557180717569208295026105115288152794 & & 421677_wp ] iflag = 0_ip bquad = 0.0_wp if ( k < 1_ip . or . k > 20_ip ) then iflag = 901_ip ! error return else if ( n < k ) then iflag = 902_ip ! error return else aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ! selection of 2, 6, or 10 point gauss formula jf = 0_ip mf = 1_ip if ( k > 4_ip ) then jf = 1_ip mf = 3_ip if ( k > 12_ip ) then jf = 4_ip mf = 5_ip end if end if do i = 1_ip , mf s ( i ) = 0.0_wp end do ilo = 1_ip inbv = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) bma = 0.5_wp * ( b - a ) bpa = 0.5_wp * ( b + a ) do m = 1_ip , mf c1 = bma * gpts ( jf + m ) gx = - c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y2 ) if ( iflag /= 0_ip ) return gx = c1 + bpa call dbvalu ( t , bcoef , n , k , 0_ip , gx , inbv , work , iflag , y1 ) if ( iflag /= 0_ip ) return s ( m ) = s ( m ) + ( y1 + y2 ) * bma end do end if end do q = 0.0_wp do m = 1_ip , mf q = q + gwts ( jf + m ) * s ( m ) end do if ( x1 > x2 ) q = - q bquad = q return end if end if iflag = 903_ip ! error return end if end subroutine dbsqad !***************************************************************************************** !***************************************************************************************** !> ! dbfqad computes the integral on `(x1,x2)` of a product of a ! function `f` and the `id`-th derivative of a `k`-th order b-spline, ! using the b-representation `(t,bcoef,n,k)`. `(x1,x2)` must be a ! subinterval of `t(k) <= x <= t(n+1)`. an integration routine, ! [[dbsgq8]] (a modification of `gaus8`), integrates the product ! on subintervals of `(x1,x2)` formed by included (distinct) knots ! !### Reference ! * D. E. Amos, \"Quadrature subroutines for splines and ! B-splines\", Report SAND79-1825, Sandia Laboratories, ! December 1979. ! !### History ! * 800901 Amos, D. E., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890531 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900326 Removed duplicate information from DESCRIPTION section. (WRB) ! * 920501 Reformatted the REFERENCES section. (WRB) ! * Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes. ! !@note the maximum number of significant digits obtainable in ! [[dbsqad]] is the smaller of ~300 and the number of digits ! carried in `real(wp)` arithmetic. ! !@note Extrapolation is not enabled for this routine. subroutine dbfqad ( f , t , bcoef , n , k , id , x1 , x2 , tol , quad , iflag , work ) implicit none procedure ( b1fqad_func ) :: f !! external function of one argument for the !! integrand `bf(x)=f(x)*dbvalu(t,bcoef,n,k,id,x,inbv,work)` integer ( ip ), intent ( in ) :: n !! length of coefficient array integer ( ip ), intent ( in ) :: k !! order of b-spline, `k >= 1` real ( wp ), dimension ( n + k ), intent ( in ) :: t !! knot array real ( wp ), dimension ( n ), intent ( in ) :: bcoef !! coefficient array integer ( ip ), intent ( in ) :: id !! order of the spline derivative, `0 <= id <= k-1` !! `id=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: x2 !! right point of quadrature interval in `t(k) <= x <= t(n+1)` real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature, suggest !! `10*dtol < tol <= 0.1` where `dtol` is the maximum !! of `1.0e-300` and real(wp) unit roundoff for !! the machine real ( wp ), intent ( out ) :: quad !! integral of `bf(x)` on `(x1,x2)` real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` integer ( ip ), intent ( out ) :: iflag !! status flag: !! !! * 0: no errors !! * 1001: `k` does not satisfy `k>=1` !! * 1002: `n` does not satisfy `n>=k` !! * 1003: `d` does not satisfy `0<=id= k ) then iflag = 1003_ip ! error else if ( tol >= min_tol . and . tol <= 0.1_wp ) then aa = min ( x1 , x2 ) bb = max ( x1 , x2 ) if ( aa >= t ( k ) ) then np1 = n + 1_ip if ( bb <= t ( np1 ) ) then if ( aa == bb ) return npk = n + k ilo = 1_ip call dintrv ( t , npk , aa , ilo , il1 , mflag ) call dintrv ( t , npk , bb , ilo , il2 , mflag ) if ( il2 >= np1 ) il2 = n inbv = 1_ip q = 0.0_wp do left = il1 , il2 ta = t ( left ) tb = t ( left + 1_ip ) if ( ta /= tb ) then a = max ( aa , ta ) b = min ( bb , tb ) call dbsgq8 ( f , t , bcoef , n , k , id , a , b , inbv , err , ans , iflag , work ) if ( iflag /= 0_ip . and . iflag /= 1101_ip ) return q = q + ans end if end do if ( x1 > x2 ) q = - q quad = q end if else iflag = 1004_ip ! error end if else iflag = 1005_ip ! error end if end if end subroutine dbfqad !***************************************************************************************** !***************************************************************************************** !> ! DBSGQ8, a modification of [gaus8](http://netlib.sandia.gov/slatec/src/gaus8.f), ! integrates the product of `fun(x)` by the `id`-th derivative of a spline ! [[dbvalu]] between limits `a` and `b` using an adaptive 8-point Legendre-Gauss ! algorithm. ! !### See also ! * [[dbfqad]] ! !### History ! * 800901 Jones, R. E., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890911 Removed unnecessary intrinsics. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900326 Removed duplicate information from DESCRIPTION section. (WRB) ! * 900328 Added TYPE section. (WRB) ! * 910408 Updated the AUTHOR section. (WRB) ! * Jacob Williams, 9/6/2017 : refactored to modern Fortran. Some changes. ! Added higher precision coefficients. subroutine dbsgq8 ( fun , xt , bc , n , kk , id , a , b , inbv , err , ans , iflag , work ) implicit none procedure ( b1fqad_func ) :: fun !! name of external function of one !! argument which multiplies [[dbvalu]]. integer ( ip ), intent ( in ) :: n !! number of b-coefficients for [[dbvalu]] integer ( ip ), intent ( in ) :: kk !! order of the spline, `kk>=1` real ( wp ), dimension (:), intent ( in ) :: xt !! knot array for [[dbvalu]] real ( wp ), dimension ( n ), intent ( in ) :: bc !! b-coefficient array for [[dbvalu]] integer ( ip ), intent ( in ) :: id !! Order of the spline derivative, `0<=id<=kk-1` real ( wp ), intent ( in ) :: a !! lower limit of integral real ( wp ), intent ( in ) :: b !! upper limit of integral (may be less than `a`) integer ( ip ), intent ( inout ) :: inbv !! initialization parameter for [[dbvalu]] real ( wp ), intent ( inout ) :: err !! **IN:** is a requested pseudorelative error !! tolerance. normally pick a value of !! `abs(err)<1e-3`. `ans` will normally !! have no more error than `abs(err)` times !! the integral of the absolute value of !! `fun(x)*[[dbvalu]]()`. !! !! **OUT:** will be an estimate of the absolute !! error in ans if the input value of `err` !! was negative. (`err` is unchanged if !! the input value of `err` was nonnegative.) !! the estimated error is solely for information !! to the user and should not be used as a !! correction to the computed integral. real ( wp ), intent ( out ) :: ans !! computed value of integral integer ( ip ), intent ( out ) :: iflag !! a status code: !! !! * 0: `ans` most likely meets requested !! error tolerance, or `a=b`. !! * 1101: `a` and `b` are too nearly equal !! to allow normal integration. !! `ans` is set to zero. !! * 1102: `ans` probably does not meet !! requested error tolerance. real ( wp ), dimension (:), intent ( inout ) :: work !! work vector of length `3*k` for [[dbvalu]] integer ( ip ) :: k , l , lmn , lmx , mxl , nbits , nib , nlmx real ( wp ) :: ae , anib , area , c , ce , ee , ef , eps , est , gl , glr , tol , vr , x integer ( ip ), dimension ( 60 ) :: lr real ( wp ), dimension ( 60 ) :: aa , hh , vl , gr integer ( ip ), parameter :: i1mach14 = digits ( 1.0_wp ) !! i1mach(14) real ( wp ), parameter :: d1mach5 = log10 ( real ( radix ( x ), wp )) !! d1mach(5) real ( wp ), parameter :: ln2 = log ( 2.0_wp ) !! 0.69314718d0 real ( wp ), parameter :: sq2 = sqrt ( 2.0_wp ) integer ( ip ), parameter :: nlmn = 1 integer ( ip ), parameter :: kmx = 5000 integer ( ip ), parameter :: kml = 6 ! initialize inbv = 1_ip iflag = 0_ip k = i1mach14 anib = d1mach5 * k / 0.30102000_wp nbits = int ( anib , ip ) nlmx = min (( nbits * 5_ip ) / 8_ip , 60_ip ) ans = 0.0_wp ce = 0.0_wp if ( a == b ) then if ( err < 0.0_wp ) err = ce else lmx = nlmx lmn = nlmn if ( b /= 0.0_wp ) then if ( sign ( 1.0_wp , b ) * a > 0.0_wp ) then c = abs ( 1.0_wp - a / b ) if ( c <= 0.1_wp ) then if ( c <= 0.0_wp ) then if ( err < 0.0_wp ) err = ce return else anib = 0.5_wp - log ( c ) / ln2 nib = int ( anib , ip ) lmx = min ( nlmx , nbits - nib - 7_ip ) if ( lmx < 1_ip ) then ! a and b are too nearly equal ! to allow normal integration iflag = 1101_ip if ( err < 0.0_wp ) err = ce return else lmn = min ( lmn , lmx ) end if end if end if end if end if tol = max ( abs ( err ), 2.0_wp ** ( 5 - nbits )) / 2.0_wp if ( err == 0.0_wp ) tol = sqrt ( epsilon ( 1.0_wp )) eps = tol hh ( 1_ip ) = ( b - a ) / 4.0_wp aa ( 1_ip ) = a lr ( 1_ip ) = 1_ip l = 1_ip call g8 ( aa ( l ) + 2.0_wp * hh ( l ), 2.0_wp * hh ( l ), est , iflag ) if ( iflag /= 0_ip ) return k = 8_ip area = abs ( est ) ef = 0.5_wp mxl = 0_ip end if do ! compute refined estimates, estimate the error, etc. call g8 ( aa ( l ) + hh ( l ), hh ( l ), gl , iflag ) if ( iflag /= 0_ip ) return call g8 ( aa ( l ) + 3.0_wp * hh ( l ), hh ( l ), gr ( l ), iflag ) if ( iflag /= 0_ip ) return k = k + 16_ip area = area + ( abs ( gl ) + abs ( gr ( l )) - abs ( est )) glr = gl + gr ( l ) ee = abs ( est - glr ) * ef ae = max ( eps * area , tol * abs ( glr )) if ( ee > ae ) then ! consider the left half of this level if ( k > kmx ) lmx = kml if ( l >= lmx ) then mxl = 1_ip else l = l + 1_ip eps = eps * 0.5_wp ef = ef / sq2 hh ( l ) = hh ( l - 1 ) * 0.5_wp lr ( l ) = - 1_ip aa ( l ) = aa ( l - 1_ip ) est = gl cycle end if end if ce = ce + ( est - glr ) if ( lr ( l ) <= 0_ip ) then ! proceed to right half at this level vl ( l ) = glr else ! return one level vr = glr do if ( l <= 1_ip ) then ! exit ans = vr if ( ( mxl /= 0_ip ) . and . ( abs ( ce ) > 2.0_wp * tol * area ) ) then iflag = 1102_ip end if if ( err < 0.0_wp ) err = ce return else l = l - 1_ip eps = eps * 2.0_wp ef = ef * sq2 if ( lr ( l ) <= 0 ) then vl ( l ) = vl ( l + 1_ip ) + vr exit else vr = vl ( l + 1_ip ) + vr end if end if end do end if est = gr ( l - 1_ip ) lr ( l ) = 1_ip aa ( l ) = aa ( l ) + 4.0_wp * hh ( l ) end do contains subroutine g8 ( x , h , res , iflag ) !! 8-point formula. !! !!@note Replaced the original double precision abscissa and weight !! coefficients with the higher precision versions from here: !! http://pomax.github.io/bezierinfo/legendre-gauss.html !! So, if `wp` is changed to say, `real128`, more precision !! can be obtained. These coefficients have about 300 digits. implicit none real ( wp ), intent ( in ) :: x real ( wp ), intent ( in ) :: h real ( wp ), intent ( out ) :: res integer ( ip ), intent ( out ) :: iflag real ( wp ), dimension ( 8 ) :: f real ( wp ), dimension ( 8 ) :: v ! abscissa and weight coefficients: real ( wp ), parameter :: x1 = & & 0.1834346424956498049394761423601839806667578129129737823171884736992044 & & 742215421141160682237111233537452676587642867666089196012523876865683788 & & 569995160663568104475551617138501966385810764205532370882654749492812314 & & 961247764619363562770645716456613159405134052985058171969174306064445289 & & 638150514997832_wp real ( wp ), parameter :: x2 = & & 0.5255324099163289858177390491892463490419642431203928577508570992724548 & & 207685612725239614001936319820619096829248252608507108793766638779939805 & & 395303668253631119018273032402360060717470006127901479587576756241288895 & & 336619643528330825624263470540184224603688817537938539658502113876953598 & & 879150514997832_wp real ( wp ), parameter :: x3 = & & 0.7966664774136267395915539364758304368371717316159648320701702950392173 & & 056764730921471519272957259390191974534530973092653656494917010859602772 & & 562074621689676153935016290342325645582634205301545856060095727342603557 & & 415761265140428851957341933710803722783136113628137267630651413319993338 & & 002150514997832_wp real ( wp ), parameter :: x4 = & & 0.9602898564975362316835608685694729904282352343014520382716397773724248 & & 977434192844394389592633122683104243928172941762102389581552171285479373 & & 642204909699700433982618326637346808781263553346927867359663480870597542 & & 547603929318533866568132868842613474896289232087639988952409772489387324 & & 25615051499783203_wp real ( wp ), parameter :: w1 = & & 0.3626837833783619829651504492771956121941460398943305405248230675666867 & & 347239066773243660420848285095502587699262967065529258215569895173844995 & & 576007862076842778350382862546305771007553373269714714894268328780431822 & & 779077846722965535548199601402487767505928976560993309027632737537826127 & & 502150514997832_wp real ( wp ), parameter :: w2 = & & 0.3137066458778872873379622019866013132603289990027349376902639450749562 & & 719421734969616980762339285560494275746410778086162472468322655616056890 & & 624276469758994622503118776562559463287222021520431626467794721603822601 & & 295276898652509723185157998353156062419751736972560423953923732838789657 & & 919150514997832_wp real ( wp ), parameter :: w3 = & & 0.2223810344533744705443559944262408844301308700512495647259092892936168 & & 145704490408536531423771979278421592661012122181231114375798525722419381 & & 826674532090577908613289536840402789398648876004385697202157482063253247 & & 195590228631570651319965589733545440605952819880671616779621183704306688 & & 233150514997832_wp real ( wp ), parameter :: w4 = & & 0.1012285362903762591525313543099621901153940910516849570590036980647401 & & 787634707848602827393040450065581543893314132667077154940308923487678731 & & 973041136073584690533208824050731976306575729205467961435779467552492328 & & 730055025992954089946676810510810729468366466585774650346143712142008566 & & 866150514997832_wp res = 0.0_wp v ( 1_ip ) = x - x1 * h v ( 2_ip ) = x + x1 * h v ( 3_ip ) = x - x2 * h v ( 4_ip ) = x + x2 * h v ( 5_ip ) = x - x3 * h v ( 6_ip ) = x + x3 * h v ( 7_ip ) = x - x4 * h v ( 8_ip ) = x + x4 * h call dbvalu ( xt , bc , n , kk , id , v ( 1_ip ), inbv , work , iflag , f ( 1_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 2_ip ), inbv , work , iflag , f ( 2_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 3_ip ), inbv , work , iflag , f ( 3_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 4_ip ), inbv , work , iflag , f ( 4_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 5_ip ), inbv , work , iflag , f ( 5_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 6_ip ), inbv , work , iflag , f ( 6_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 7_ip ), inbv , work , iflag , f ( 7_ip )); if ( iflag /= 0_ip ) return call dbvalu ( xt , bc , n , kk , id , v ( 8_ip ), inbv , work , iflag , f ( 8_ip )); if ( iflag /= 0_ip ) return res = h * (( w1 * ( fun ( v ( 1_ip )) * f ( 1_ip ) + fun ( v ( 2_ip )) * f ( 2_ip )) + & w2 * ( fun ( v ( 3_ip )) * f ( 3_ip ) + fun ( v ( 4_ip )) * f ( 4_ip ))) + & ( w3 * ( fun ( v ( 5_ip )) * f ( 5_ip ) + fun ( v ( 6_ip )) * f ( 6_ip )) + & w4 * ( fun ( v ( 7_ip )) * f ( 7_ip ) + fun ( v ( 8_ip )) * f ( 8_ip )))) end subroutine g8 end subroutine dbsgq8 !***************************************************************************************** !***************************************************************************************** !> ! Returns the value of `x` to use for computing the interval ! in `t`, depending on if extrapolation is allowed or not. ! ! If extrapolation is allowed and x is < tmin or > tmax, then either ! `tmin` or `tmax - 2.0_wp*spacing(tmax)` is returned. ! Otherwise, `x` is returned. pure function get_temp_x_for_extrap ( x , tmin , tmax , extrap ) result ( xt ) implicit none real ( wp ), intent ( in ) :: x !! variable value real ( wp ), intent ( in ) :: tmin !! first knot vector element for b-splines real ( wp ), intent ( in ) :: tmax !! last knot vector element for b-splines real ( wp ) :: xt !! The value returned (it will either !! be `tmin`, `x`, or `tmax`) logical , intent ( in ), optional :: extrap !! if extrapolation is allowed !! (if not present, default is False) logical :: extrapolation_allowed !! if extrapolation is allowed if ( present ( extrap )) then extrapolation_allowed = extrap else extrapolation_allowed = . false . end if if ( extrapolation_allowed ) then if ( x < tmin ) then xt = tmin else if ( x > tmax ) then ! Put it just inside the upper bound. ! This is sort of a hack to get ! extrapolation to work. xt = tmax - 2.0_wp * spacing ( tmax ) else xt = x end if else xt = x end if end function get_temp_x_for_extrap !***************************************************************************************** !***************************************************************************************** !> ! Returns a message string associated with the status code. pure function get_status_message ( iflag ) result ( msg ) implicit none integer ( ip ), intent ( in ) :: iflag !! return code from one of the routines character ( len = :), allocatable :: msg !! status message associated with the flag character ( len = 10 ) :: istr !! for integer to string conversion integer ( ip ) :: istat !! for write statement select case ( iflag ) case ( 0_ip ); msg = 'Successful execution' case ( - 1_ip ); msg = 'Error in dintrv: x < xt(1_ip)' case ( - 2_ip ); msg = 'Error in dintrv: x >= xt(lxt)' case ( 1_ip ); msg = 'Error in evaluate_*d: class is not initialized' case ( 2_ip ); msg = 'Error in db*ink: iknot out of range' case ( 3_ip ); msg = 'Error in db*ink: nx out of range' case ( 4_ip ); msg = 'Error in db*ink: kx out of range' case ( 5_ip ); msg = 'Error in db*ink: x not strictly increasing' case ( 6_ip ); msg = 'Error in db*ink: tx not non-decreasing' case ( 7_ip ); msg = 'Error in db*ink: ny out of range' case ( 8_ip ); msg = 'Error in db*ink: ky out of range' case ( 9_ip ); msg = 'Error in db*ink: y not strictly increasing' case ( 10_ip ); msg = 'Error in db*ink: ty not non-decreasing' case ( 11_ip ); msg = 'Error in db*ink: nz out of range' case ( 12_ip ); msg = 'Error in db*ink: kz out of range' case ( 13_ip ); msg = 'Error in db*ink: z not strictly increasing' case ( 14_ip ); msg = 'Error in db*ink: tz not non-decreasing' case ( 15_ip ); msg = 'Error in db*ink: nq out of range' case ( 16_ip ); msg = 'Error in db*ink: kq out of range' case ( 17_ip ); msg = 'Error in db*ink: q not strictly increasing' case ( 18_ip ); msg = 'Error in db*ink: tq not non-decreasing' case ( 19_ip ); msg = 'Error in db*ink: nr out of range' case ( 20_ip ); msg = 'Error in db*ink: kr out of range' case ( 21_ip ); msg = 'Error in db*ink: r not strictly increasing' case ( 22_ip ); msg = 'Error in db*ink: tr not non-decreasing' case ( 23_ip ); msg = 'Error in db*ink: ns out of range' case ( 24_ip ); msg = 'Error in db*ink: ks out of range' case ( 25_ip ); msg = 'Error in db*ink: s not strictly increasing' case ( 26_ip ); msg = 'Error in db*ink: ts not non-decreasing' case ( 700_ip ); msg = 'Error in db*ink: size(x) /= size(fcn,1)' case ( 701_ip ); msg = 'Error in db*ink: size(y) /= size(fcn,2)' case ( 702_ip ); msg = 'Error in db*ink: size(z) /= size(fcn,3)' case ( 703_ip ); msg = 'Error in db*ink: size(q) /= size(fcn,4)' case ( 704_ip ); msg = 'Error in db*ink: size(r) /= size(fcn,5)' case ( 705_ip ); msg = 'Error in db*ink: size(s) /= size(fcn,6)' case ( 706_ip ); msg = 'Error in db*ink: size(x) /= nx' case ( 707_ip ); msg = 'Error in db*ink: size(y) /= ny' case ( 708_ip ); msg = 'Error in db*ink: size(z) /= nz' case ( 709_ip ); msg = 'Error in db*ink: size(q) /= nq' case ( 710_ip ); msg = 'Error in db*ink: size(r) /= nr' case ( 711_ip ); msg = 'Error in db*ink: size(s) /= ns' case ( 712_ip ); msg = 'Error in db*ink: size(tx) /= nx+kx' case ( 713_ip ); msg = 'Error in db*ink: size(ty) /= ny+ky' case ( 714_ip ); msg = 'Error in db*ink: size(tz) /= nz+kz' case ( 715_ip ); msg = 'Error in db*ink: size(tq) /= nq+kq' case ( 716_ip ); msg = 'Error in db*ink: size(tr) /= nr+kr' case ( 717_ip ); msg = 'Error in db*ink: size(ts) /= ns+ks' case ( 800_ip ); msg = 'Error in db*ink: size(x) /= size(bcoef,1)' case ( 801_ip ); msg = 'Error in db*ink: size(y) /= size(bcoef,2)' case ( 802_ip ); msg = 'Error in db*ink: size(z) /= size(bcoef,3)' case ( 803_ip ); msg = 'Error in db*ink: size(q) /= size(bcoef,4)' case ( 804_ip ); msg = 'Error in db*ink: size(r) /= size(bcoef,5)' case ( 805_ip ); msg = 'Error in db*ink: size(s) /= size(bcoef,6)' case ( 806_ip ); msg = 'Error in dbint4: currently, only k=4 can be used' case ( 100_ip ); msg = 'Error in dbintk: k does not satisfy k>=1' case ( 101_ip ); msg = 'Error in dbintk: n does not satisfy n>=k' case ( 102_ip ); msg = 'Error in dbintk: x(i) does not satisfy x(i)sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_blas_module.f90~~AfferentGraph sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! BLAS procedures, which can be use used if not linking with a BLAS library, ! if one is not available, or if a real kind /= `real64` is required. ! ! The original code has been slightly modernized. ! !### Notes !``` ! reference blas level1 routines ! reference blas is a software package provided by univ. of tennessee, ! univ. of california berkeley, univ. of colorado denver and nag ltd. !``` ! !### See also ! * [BLAS Sourcecode](https://github.com/Reference-LAPACK/lapack/tree/master/BLAS/SRC) module bspline_blas_module #ifndef HAS_BLAS use bspline_kinds_module , only : wp , ip implicit none private public :: daxpy , dcopy , dscal , dswap , ddot , dnrm2 , dasum , idamax , drotm , drotmg contains subroutine daxpy ( n , da , dx , incx , dy , incy ) !! DAXPY constant times a vector plus a vector. !! uses unrolled loops for increments equal to one. real ( wp ) :: da integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( da == 0.0_wp ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 4_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dy ( i ) + da * dx ( i ) end do end if if ( n < 4_ip ) return mp1 = m + 1_ip do i = mp1 , n , 4_ip dy ( i ) = dy ( i ) + da * dx ( i ) dy ( i + 1_ip ) = dy ( i + 1_ip ) + da * dx ( i + 1_ip ) dy ( i + 2_ip ) = dy ( i + 2_ip ) + da * dx ( i + 2_ip ) dy ( i + 3_ip ) = dy ( i + 3_ip ) + da * dx ( i + 3_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dy ( iy ) + da * dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine daxpy subroutine dcopy ( n , dx , incx , dy , incy ) !! DCOPY copies a vector, x, to a vector, y. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 7_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dy ( i ) = dx ( i ) end do if ( n < 7_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 7_ip dy ( i ) = dx ( i ) dy ( i + 1_ip ) = dx ( i + 1_ip ) dy ( i + 2_ip ) = dx ( i + 2_ip ) dy ( i + 3_ip ) = dx ( i + 3_ip ) dy ( i + 4_ip ) = dx ( i + 4_ip ) dy ( i + 5_ip ) = dx ( i + 5_ip ) dy ( i + 6_ip ) = dx ( i + 6_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dy ( iy ) = dx ( ix ) ix = ix + incx iy = iy + incy end do end if end subroutine dcopy subroutine dscal ( n , da , dx , incx ) !! DSCAL scales a vector by a constant. !! uses unrolled loops for increment equal to 1. real ( wp ) :: da integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) integer i , m , mp1 , nincx if ( n <= 0_ip . or . incx <= 0_ip ) return if ( incx == 1_ip ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dx ( i ) = da * dx ( i ) end do if ( n < 5_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dx ( i ) = da * dx ( i ) dx ( i + 1_ip ) = da * dx ( i + 1_ip ) dx ( i + 2_ip ) = da * dx ( i + 2_ip ) dx ( i + 3_ip ) = da * dx ( i + 3_ip ) dx ( i + 4_ip ) = da * dx ( i + 4_ip ) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1_ip , nincx , incx dx ( i ) = da * dx ( i ) end do end if end subroutine dscal subroutine dswap ( n , dx , incx , dy , incy ) !! DSWAP interchanges two vectors. !! uses unrolled loops for increments equal to 1. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 3_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp end do if ( n < 3_ip ) return end if mp1 = m + 1_ip do i = mp1 , n , 3_ip dtemp = dx ( i ) dx ( i ) = dy ( i ) dy ( i ) = dtemp dtemp = dx ( i + 1_ip ) dx ( i + 1_ip ) = dy ( i + 1_ip ) dy ( i + 1_ip ) = dtemp dtemp = dx ( i + 2_ip ) dx ( i + 2_ip ) = dy ( i + 2_ip ) dy ( i + 2_ip ) = dtemp end do else ! code for unequal increments or equal increments not equal ! to 1 ix = 1 iy = 1 if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dx ( ix ) dx ( ix ) = dy ( iy ) dy ( iy ) = dtemp ix = ix + incx iy = iy + incy end do end if end subroutine dswap real ( wp ) function ddot ( n , dx , incx , dy , incy ) !! ddot forms the dot product of two vectors. !! uses unrolled loops for increments equal to one. integer ( ip ) :: incx , incy , n real ( wp ) :: dx ( * ), dy ( * ) real ( wp ) :: dtemp integer ( ip ) :: i , ix , iy , m , mp1 ddot = 0.0_wp dtemp = 0.0_wp if ( n <= 0_ip ) return if ( incx == 1_ip . and . incy == 1_ip ) then ! code for both increments equal to 1 ! clean-up loop m = mod ( n , 5_ip ) if ( m /= 0_ip ) then do i = 1_ip , m dtemp = dtemp + dx ( i ) * dy ( i ) end do if ( n < 5_ip ) then ddot = dtemp return end if end if mp1 = m + 1_ip do i = mp1 , n , 5_ip dtemp = dtemp + dx ( i ) * dy ( i ) + & dx ( i + 1_ip ) * dy ( i + 1_ip ) + dx ( i + 2_ip ) * dy ( i + 2_ip ) + & dx ( i + 3_ip ) * dy ( i + 3_ip ) + dx ( i + 4_ip ) * dy ( i + 4_ip ) end do else ! code for unequal increments or equal increments ! not equal to 1 ix = 1_ip iy = 1_ip if ( incx < 0_ip ) ix = ( - n + 1_ip ) * incx + 1_ip if ( incy < 0_ip ) iy = ( - n + 1_ip ) * incy + 1_ip do i = 1_ip , n dtemp = dtemp + dx ( ix ) * dy ( iy ) ix = ix + incx iy = iy + incy end do end if ddot = dtemp end function ddot function dnrm2 ( n , x , incx ) !! returns the euclidean norm of a vector real ( wp ) :: dnrm2 real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: maxN = huge ( 0.0_wp ) real ( wp ), parameter :: tsml = real ( radix ( 0._wp ), wp ) ** ceiling ( & ( minexponent ( 0._wp ) - 1 ) * 0.5_wp ) real ( wp ), parameter :: tbig = real ( radix ( 0._wp ), wp ) ** floor ( & ( maxexponent ( 0._wp ) - digits ( 0._wp ) + 1 ) * 0.5_wp ) real ( wp ), parameter :: ssml = real ( radix ( 0._wp ), wp ) ** ( - floor ( & ( minexponent ( 0._wp ) - digits ( 0._wp )) * 0.5_wp )) real ( wp ), parameter :: sbig = real ( radix ( 0._wp ), wp ) ** ( - ceiling ( & ( maxexponent ( 0._wp ) + digits ( 0._wp ) - 1 ) * 0.5_wp )) integer ( ip ) :: incx , n real ( wp ) :: x ( * ) integer ( ip ) :: i , ix logical :: notbig real ( wp ) :: abig , amed , asml , ax , scl , sumsq , ymax , ymin ! ! Quick return if possible ! DNRM2 = zero if ( n <= 0 ) return ! scl = one sumsq = zero ! ! Compute the sum of squares in 3 accumulators: ! abig -- sums of squares scaled down to avoid overflow ! asml -- sums of squares scaled up to avoid underflow ! amed -- sums of squares that do not require scaling ! The thresholds and multipliers are ! tbig -- values bigger than this are scaled down by sbig ! tsml -- values smaller than this are scaled up by ssml ! notbig = . true . asml = zero amed = zero abig = zero ix = 1 if ( incx < 0 ) ix = 1 - ( n - 1 ) * incx do i = 1 , n ax = abs ( x ( ix )) if ( ax > tbig ) then abig = abig + ( ax * sbig ) ** 2 notbig = . false . else if ( ax < tsml ) then if ( notbig ) asml = asml + ( ax * ssml ) ** 2 else amed = amed + ax ** 2 end if ix = ix + incx end do ! ! Combine abig and amed or amed and asml if more than one ! accumulator was used. ! if ( abig > zero ) then ! ! Combine abig and amed if abig > 0. ! if ( ( amed > zero ) . or . ( amed > maxN ) . or . ( amed /= amed ) ) then abig = abig + ( amed * sbig ) * sbig end if scl = one / sbig sumsq = abig else if ( asml > zero ) then ! ! Combine amed and asml if asml > 0. ! if ( ( amed > zero ) . or . ( amed > maxN ) . or . ( amed /= amed ) ) then amed = sqrt ( amed ) asml = sqrt ( asml ) / ssml if ( asml > amed ) then ymin = amed ymax = asml else ymin = asml ymax = amed end if scl = one sumsq = ymax ** 2 * ( one + ( ymin / ymax ) ** 2 ) else scl = one / ssml sumsq = asml end if else ! ! Otherwise all values are mid-range ! scl = one sumsq = amed end if DNRM2 = scl * sqrt ( sumsq ) return end function real ( wp ) function dasum ( n , dx , incx ) !! dasum takes the sum of the absolute values. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) dtemp integer ( ip ) i , m , mp1 , nincx dasum = 0.0_wp dtemp = 0.0_wp if ( n <= 0 . or . incx <= 0 ) return if ( incx == 1 ) then ! code for increment equal to 1 ! clean-up loop m = mod ( n , 6 ) if ( m /= 0 ) then do i = 1 , m dtemp = dtemp + abs ( dx ( i )) end do if ( n < 6 ) then dasum = dtemp return end if end if mp1 = m + 1 do i = mp1 , n , 6 dtemp = dtemp + abs ( dx ( i )) + abs ( dx ( i + 1 )) + & abs ( dx ( i + 2 )) + abs ( dx ( i + 3 )) + & abs ( dx ( i + 4 )) + abs ( dx ( i + 5 )) end do else ! code for increment not equal to 1 nincx = n * incx do i = 1 , nincx , incx dtemp = dtemp + abs ( dx ( i )) end do end if dasum = dtemp end function dasum integer function idamax ( n , dx , incx ) !! idamax finds the index of the first element having maximum absolute value. integer ( ip ) :: incx , n real ( wp ) :: dx ( * ) real ( wp ) :: dmax integer ( ip ) :: i , ix idamax = 0 if ( n < 1 . or . incx <= 0 ) return idamax = 1 if ( n == 1 ) return if ( incx == 1 ) then ! code for increment equal to 1 dmax = abs ( dx ( 1 )) do i = 2 , n if ( abs ( dx ( i )) > dmax ) then idamax = i dmax = abs ( dx ( i )) end if end do else ! code for increment not equal to 1 ix = 1 dmax = abs ( dx ( 1 )) ix = ix + incx do i = 2 , n if ( abs ( dx ( ix )) > dmax ) then idamax = i dmax = abs ( dx ( ix )) end if ix = ix + incx end do end if end function idamax subroutine drotm ( n , dx , incx , dy , incy , dparam ) !! apply the modified givens transformation, H, to the 2 by n matrix integer ( ip ) :: incx , incy , n real ( wp ) :: dparam ( 5 ), dx ( * ), dy ( * ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , w , z integer ( ip ) :: i , kx , ky , nsteps real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: two = 2.0_wp dflag = dparam ( 1 ) if ( n <= 0 . or . ( dflag + two == zero )) return if ( incx == incy . and . incx > 0 ) then nsteps = n * incx if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z * dh12 dy ( i ) = w * dh21 + z * dh22 end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w + z * dh12 dy ( i ) = w * dh21 + z end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , nsteps , incx w = dx ( i ) z = dy ( i ) dx ( i ) = w * dh11 + z dy ( i ) = - w + dh22 * z end do end if else kx = 1 ky = 1 if ( incx < 0 ) kx = 1 + ( 1 - n ) * incx if ( incy < 0 ) ky = 1 + ( 1 - n ) * incy if ( dflag < zero ) then dh11 = dparam ( 2 ) dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z * dh12 dy ( ky ) = w * dh21 + z * dh22 kx = kx + incx ky = ky + incy end do else if ( dflag == zero ) then dh12 = dparam ( 4 ) dh21 = dparam ( 3 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w + z * dh12 dy ( ky ) = w * dh21 + z kx = kx + incx ky = ky + incy end do else dh11 = dparam ( 2 ) dh22 = dparam ( 5 ) do i = 1 , n w = dx ( kx ) z = dy ( ky ) dx ( kx ) = w * dh11 + z dy ( ky ) = - w + dh22 * z kx = kx + incx ky = ky + incy end do end if end if end subroutine drotm subroutine drotmg ( dd1 , dd2 , dx1 , dy1 , dparam ) !! construct the modified givens transformation matrix H real ( wp ) :: dd1 , dd2 , dx1 , dy1 real ( wp ) :: dparam ( 5 ) real ( wp ) :: dflag , dh11 , dh12 , dh21 , dh22 , dp1 , dp2 , dq1 , dq2 , dtemp ,& du real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: two = 2.0_wp real ( wp ), parameter :: gam = 409 6.0_wp real ( wp ), parameter :: gamsq = gam * gam !! 16777216.0_wp real ( wp ), parameter :: rgamsq = one / gamsq !! 5.9604645e-8_wp if ( dd1 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else ! case-dd1-nonnegative dp2 = dd2 * dy1 if ( dp2 == zero ) then dflag = - two dparam ( 1 ) = dflag return end if ! regular-case.. dp1 = dd1 * dx1 dq2 = dp2 * dy1 dq1 = dp1 * dx1 if ( abs ( dq1 ) > abs ( dq2 )) then dh21 = - dy1 / dx1 dh12 = dp2 / dp1 du = one - dh12 * dh21 if ( du > zero ) then dflag = zero dd1 = dd1 / du dd2 = dd2 / du dx1 = dx1 * du else ! this code path if here for safety. we do not expect this ! condition to ever hold except in edge cases with rounding ! errors. see doi: 10.1145/355841.355847 dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero end if else if ( dq2 < zero ) then ! go zero-h-d-and-dx1.. dflag = - one dh11 = zero dh12 = zero dh21 = zero dh22 = zero dd1 = zero dd2 = zero dx1 = zero else dflag = one dh11 = dp1 / dp2 dh22 = dx1 / dy1 du = one + dh11 * dh22 dtemp = dd2 / du dd2 = dd1 / du dd1 = dtemp dx1 = dy1 * du end if end if ! procedure..scale-check if ( dd1 /= zero ) then do while (( dd1 <= rgamsq ) . or . ( dd1 >= gamsq )) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( dd1 <= rgamsq ) then dd1 = dd1 * gam ** 2 dx1 = dx1 / gam dh11 = dh11 / gam dh12 = dh12 / gam else dd1 = dd1 / gam ** 2 dx1 = dx1 * gam dh11 = dh11 * gam dh12 = dh12 * gam end if enddo end if if ( dd2 /= zero ) then do while ( ( abs ( dd2 ) <= rgamsq ) . or . ( abs ( dd2 ) >= gamsq ) ) if ( dflag == zero ) then dh11 = one dh22 = one dflag = - one else dh21 = - one dh12 = one dflag = - one end if if ( abs ( dd2 ) <= rgamsq ) then dd2 = dd2 * gam ** 2 dh21 = dh21 / gam dh22 = dh22 / gam else dd2 = dd2 / gam ** 2 dh21 = dh21 * gam dh22 = dh22 * gam end if end do end if end if if ( dflag < zero ) then dparam ( 2 ) = dh11 dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 dparam ( 5 ) = dh22 else if ( dflag == zero ) then dparam ( 3 ) = dh21 dparam ( 4 ) = dh12 else dparam ( 2 ) = dh11 dparam ( 5 ) = dh22 end if dparam ( 1 ) = dflag end subroutine drotmg #endif end module bspline_blas_module","tags":"","loc":"sourcefile/bspline_blas_module.f90.html"},{"title":"bspline_defc_module.F90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_defc_module.f90~~EfferentGraph sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_blas_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_defc_module.f90~~AfferentGraph sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> ! [[defc]] and [[dfc]] procedures and support routines from [SLATEC](https://netlib.org/slatec/src/). ! For fitting B-splines polynomials to discrete 1D data. ! !### References ! ! For a description of the B-splines and usage instructions to ! evaluate them, see: ! ! * C. W. de Boor, Package for Calculating with B-Splines. ! SIAM J. Numer. Anal., p. 441, (June, 1977). ! ! For further discussion of (constrained) curve fitting using ! B-splines, see reference 2. ! ! * R. J. Hanson, Constrained least squares curve fitting ! to discrete data using B-splines, a users guide, ! Report SAND78-1291, Sandia Laboratories, December ! 1978. ! !### History ! * Dec 2022 (Jacob Williams) : Cleanup and modernization of the SLATEC routines. ! !@note This module does not support the user-defined `ip` integer kind. ! It only uses the default integer kind. ! !@todo add `iflag` outputs to be consistent with the rest of the library. module bspline_defc_module use bspline_kinds_module , only : wp !, ip #ifndef HAS_BLAS use bspline_blas_module #endif implicit none private real ( wp ), parameter :: drelpr = epsilon ( 1.0_wp ) !! machine precision (`d1mach(4)`) #ifdef HAS_BLAS ! user is linking against an external BLAS library double precision , external :: ddot , dasum integer , external :: idamax external :: daxpy , dcopy , dscal , dswap , dnrm2 , drotm , drotmg #endif public :: defc , dfc , dcv contains !***************************************************************************************** !***************************************************************************************** !> ! This subprogram fits a piecewise polynomial curve ! to discrete data. The piecewise polynomials are ! represented as B-splines. ! The fitting is done in a weighted least squares sense. ! ! The data can be processed in groups of modest size. ! The size of the group is chosen by the user. This feature ! may be necessary for purposes of using constrained curve fitting ! with subprogram [[DFC]] on a very large data set. ! !### Evaluating the Fitted Curve ! ! To evaluate derivative number `IDER` at `XVAL`, ! use the function subprogram [[DBVALU]]. ! !```fortran ! f = dbvalu(bkpt,coeff,nbkpt-nord,nord,ider,xval,inbv,workb) !``` ! ! The output of this subprogram will not be ! defined unless an output value of `MDEOUT=1` ! was obtained from [[DEFC]], `XVAL` is in the data ! interval, and `IDER` is nonnegative and `< NORD`. ! ! The first time [[DBVALU]] is called, `INBV=1` ! must be specified. This value of `INBV` is the ! overwritten by [[DBVALU]]. The array `WORKB(*)` ! must be of length at least `3*NORD`, and must ! not be the same as the `W(*)` array used in the ! call to [[DEFC]]. ! ! [[DBVALU]] expects the breakpoint array `BKPT(*)` ! to be sorted. ! !### Revision history ! ! * 800801 DATE WRITTEN. ! WRITTEN BY R. HANSON, SANDIA NATL. LABS., ! ALB., N. M., AUGUST-SEPTEMBER, 1980. ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890531 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900510 Change Prologue comments to refer to XERMSG. (RWC) ! * 900607 Editorial changes to Prologue to make Prologues for EFC, ! DEFC, FC, and DFC look as much the same as possible. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) ! * Jacob Williams, 2022 : modernized subroutine defc ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , & Mdeout , Coeff , Lw , w ) integer , intent ( in ) :: Ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), dimension ( ndata ), intent ( in ) :: Xdata !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), dimension ( ndata ), intent ( in ) :: Ydata !! Y data array. real ( wp ), dimension ( ndata ), intent ( in ) :: Sddata !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: Nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension (:), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: Mdein !! An integer flag, with one of two possible !! values (1 or 2), that directs the subprogram !! action with regard to new data points provided !! by the user: !! !! * `= 1` The first time that [[DEFC]] has been !! entered. There are NDATA points to process. !! * `= 2` This is another entry to DEFC(). The !! subprogram [[DEFC]] has been entered with MDEIN=1 !! exactly once before for this problem. There !! are NDATA new additional points to merge and !! process with any previous points. !! (When using [[DEFC]] with MDEIN=2 it is !! important that the set of knots remain fixed at the !! same values for all entries to [[DEFC]].) integer , intent ( out ) :: Mdeout !! An output flag that indicates the status !! of the curve fit: !! !! * `=-1` A usage error of [[DEFC]] occurred. The !! offending condition is noted with the SLATEC !! library error processor, `XERMSG( )`. In case !! the working array `W(*)` is not long enough, the !! minimal acceptable length is printed. !! !! * `=1` The B-spline coefficients for the fitted !! curve have been returned in array `COEFF(*)`. !! !! * `=2` Not enough data has been processed to !! determine the B-spline coefficients. !! The user has one of two options. Continue !! to process more data until a unique set !! of coefficients is obtained, or use the !! subprogram [[DFC]] to obtain a specific !! set of coefficients. The user should read !! the usage instructions for [[DFC]] for further !! details if this second option is chosen. real ( wp ), intent ( out ) :: Coeff ( * ) !! If the output value of `MDEOUT=1`, this array !! contains the unknowns obtained from the least !! squares fitting process. These `N=NBKPT-NORD` !! parameters are the B-spline coefficients. !! For `MDEOUT=2`, not enough data was processed to !! uniquely determine the B-spline coefficients. !! In this case, and also when `MDEOUT=-1`, all !! values of `COEFF(*)` are set to zero. !! !! If the user is not satisfied with the fitted !! curve returned by [[DEFC]], the constrained !! least squares curve fitting subprogram [[DFC]] !! may be required. The work done within [[DEFC]] !! to accumulate the data can be utilized by !! the user, if so desired. This involves !! saving the first `(NBKPT-NORD+3)*(NORD+1)` !! entries of `W(*)` and providing this data !! to [[DFC]] with the \"old problem\" designation. !! The user should read the usage instructions !! for subprogram [[DFC]] for further details. integer , intent ( in ) :: Lw !! The amount of working storage actually !! allocated for the working array `W(*)`. !! This quantity is compared with the !! actual amount of storage needed in [[DEFC]]. !! Insufficient storage allocated for `W(*)` is !! an error. This feature was included in [[DEFC]] !! because misreading the storage formula !! for `W(*)` might very well lead to subtle !! and hard-to-find programming bugs. !! !! The length of the array `W(*)` must satisfy !!``` !! LW >= (NBKPT-NORD+3)*(NORD+1)+ !! (NBKPT+1)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` real ( wp ) :: w ( * ) !! Working Array. !! Its length is specified as an input parameter !! in `LW` as noted above. The contents of `W(*)` !! must not be modified by the user between calls !! to [[DEFC]] with values of `MDEIN=1,2,2,...` . !! The first `(NBKPT-NORD+3)*(NORD+1)` entries of !! `W(*)` are acceptable as direct input to [[DFC]] !! for an \"old problem\" only when `MDEOUT=1` or `2`. integer :: lbf , lbkpt , lg , lptemp , lww , lxtemp , mdg , mdw ! LWW=1 USAGE IN DEFCMN( ) OF W(*).. ! LWW,...,LG-1 W(*,*) ! LG,...,LXTEMP-1 G(*,*) ! LXTEMP,...,LPTEMP-1 XTEMP(*) ! LPTEMP,...,LBKPT-1 PTEMP(*) ! LBKPT,...,LBF BKPT(*) (LOCAL TO DEFCMN( )) ! LBF,...,LBF+NORD**2 BF(*,*) mdg = Nbkpt + 1 mdw = Nbkpt - Nord + 3 lww = 1 lg = lww + mdw * ( Nord + 1 ) lxtemp = lg + mdg * ( Nord + 1 ) lptemp = lxtemp + max ( Ndata , Nbkpt ) lbkpt = lptemp + max ( Ndata , Nbkpt ) lbf = lbkpt + Nbkpt call defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkpt , Mdein , Mdeout , & Coeff , w ( lbf ), w ( lxtemp ), w ( lptemp ), w ( lbkpt ), w ( lg ), mdg , & w ( lww ), mdw , Lw ) end subroutine defc !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DEFC]]. ! This subprogram does weighted least squares fitting of data by ! B-spline curves. ! The documentation for [[DEFC]] has complete usage instructions. ! !### Revision history ! * 800801 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900328 Added TYPE section. (WRB) ! * 900510 Convert XERRWV calls to XERMSG calls. (RWC) ! * 900604 DP version created from SP version. (RWC) subroutine defcmn ( Ndata , Xdata , Ydata , Sddata , Nord , Nbkpt , Bkptin , & Mdein , Mdeout , Coeff , Bf , Xtemp , Ptemp , Bkpt , g , Mdg , w , & Mdw , Lw ) integer :: Lw , Mdein , Mdeout , Mdg , Mdw , Nbkpt , Ndata , Nord real ( wp ) :: Bf ( Nord , * ), Bkpt ( * ), Bkptin ( * ), Coeff ( * ), & g ( Mdg , * ), Ptemp ( * ), Sddata ( * ), w ( Mdw , * ), & Xdata ( * ), Xtemp ( * ), Ydata ( * ) real ( wp ) :: rnorm , xmax , xmin , xval integer :: i , idata , ileft , intseq , ip , ir , irow , l , mt , n , & nb , nordm1 , nordp1 , np1 character ( len = 8 ) :: xern1 , xern2 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Initialize variables and analyze input. n = Nbkpt - Nord np1 = n + 1 ! Initially set all output coefficients to zero. call dcopy ( n , [ 0.0_wp ], 0 , Coeff , 1 ) Mdeout = - 1 if ( Nord < 1 . or . Nord > 20 ) then write ( * , * ) 'IN DEFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' return end if if ( Nbkpt < 2 * Nord ) then write ( * , * ) 'IN DEFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE THE B-SPLINE ORDER.' return end if if ( Ndata < 0 ) then write ( * , * ) 'IN DEFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' return end if nb = ( Nbkpt - Nord + 3 ) * ( Nord + 1 ) + ( Nbkpt + 1 ) * ( Nord + 1 ) & + 2 * max ( Nbkpt , Ndata ) + Nbkpt + Nord ** 2 if ( Lw < nb ) then write ( xern1 , '(I8)' ) nb write ( xern2 , '(I8)' ) Lw write ( * , * ) 'IN DEFC, INSUFFICIENT STORAGE FOR W(*). CHECK FORMULA ' // & 'THAT READS LW>= ... . NEED = ' // xern1 // & ' GIVEN = ' // xern2 Mdeout = - 1 return end if if ( Mdein /= 1 . and . Mdein /= 2 ) then write ( * , * ) 'IN DEFC, INPUT VALUE OF MDEIN MUST BE 1-2.' return end if ! Sort the breakpoints. call dcopy ( Nbkpt , Bkptin , 1 , Bkpt , 1 ) call dsort ( Nbkpt , 1 , Bkpt ) ! Save interval containing knots. xmin = Bkpt ( Nord ) xmax = Bkpt ( np1 ) nordm1 = Nord - 1 nordp1 = Nord + 1 ! Process least squares equations. ! Sort data and an array of pointers. call dcopy ( Ndata , Xdata , 1 , Xtemp , 1 ) do i = 1 , Ndata Ptemp ( i ) = i end do ! JW : really Ptemp should be an integer array. ! it is real because they are stuffing it in ! a real work array and also using dsort on it. if ( Ndata > 0 ) then call dsort ( Ndata , 2 , Xtemp , Ptemp ) xmin = min ( xmin , Xtemp ( 1 )) xmax = max ( xmax , Xtemp ( Ndata )) end if ! Fix breakpoint array if needed. This should only involve very ! minor differences with the input array of breakpoints. do i = 1 , Nord Bkpt ( i ) = min ( Bkpt ( i ), xmin ) end do do i = np1 , Nbkpt Bkpt ( i ) = max ( Bkpt ( i ), xmax ) end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = Nord intseq = 1 do idata = 1 , Ndata ! Sorted indices are in PTEMP(*). l = int ( Ptemp ( idata )) xval = Xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= Bkpt ( ileft + 1 )) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ILEFT<=N. do ileft = ileft , n if ( xval < Bkpt ( ileft + 1 )) exit if ( Mdein == 2 ) then ! Data is being sequentially accumulated. ! Transfer previously accumulated rows from W(*,*) to ! G(*,*) and process them. call dcopy ( nordp1 , w ( intseq , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , intseq ) intseq = intseq + 1 end if end do end if ! Obtain B-spline function value. call dfspvn ( Bkpt , Nord , 1 , xval , ileft , Bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( Nord , Bf , 1 , g ( irow , 1 ), Mdg ) g ( irow , nordp1 ) = Ydata ( l ) ! Scale data if uncertainty is nonzero. if ( Sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / Sddata ( l ), g ( irow , 1 ), Mdg ) ! When staging work area is exhausted, process rows. if ( irow == Mdg - 1 ) then call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) mt = 0 end if end do ! Process last block of equations. call dbndac ( g , Mdg , Nord , ip , ir , mt , ileft - nordm1 ) ! Finish processing any previously accumulated rows from W(*,*) ! to G(*,*). if ( Mdein == 2 ) then do i = intseq , np1 call dcopy ( nordp1 , w ( i , 1 ), Mdw , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , min ( n , i )) end do end if ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), Mdg ) call dbndac ( g , Mdg , Nord , ip , ir , 1 , np1 ) ! Transfer accumulated rows from G(*,*) to W(*,*) for ! possible later sequential accumulation. do i = 1 , np1 call dcopy ( nordp1 , g ( i , 1 ), Mdg , w ( i , 1 ), Mdw ) end do ! Solve for coefficients when possible. do i = 1 , n if ( g ( i , 1 ) == 0.0_wp ) then Mdeout = 2 return end if end do ! All the diagonal terms in the accumulated triangular ! matrix are nonzero. The solution can be computed but ! it may be unsuitable for further use due to poor ! conditioning or the lack of constraints. No checking ! for either of these is done here. call dbndsl ( 1 , g , Mdg , Nord , ip , ir , Coeff , n , rnorm ) Mdeout = 1 end subroutine defcmn !***************************************************************************************** !***************************************************************************************** !> ! These subroutines solve the least squares problem `Ax = b` for ! banded matrices A using sequential accumulation of rows of the ! data matrix. Exactly one right-hand side vector is permitted. ! ! These subroutines are intended for the type of least squares ! systems that arise in applications such as curve or surface ! fitting of data. The least squares equations are accumulated and ! processed using only part of the data. This requires a certain ! user interaction during the solution of Ax = b. ! ! Specifically, suppose the data matrix (A B) is row partitioned ! into Q submatrices. Let (E F) be the T-th one of these ! submatrices where E = (0 C 0). Here the dimension of E is MT by N ! and the dimension of C is MT by NB. The value of NB is the ! bandwidth of A. The dimensions of the leading block of zeros in E ! are MT by JT-1. ! ! The user of the subroutine DBNDAC provides MT,JT,C and F for ! T=1,...,Q. Not all of this data must be supplied at once. ! ! Following the processing of the various blocks (E F), the matrix ! (A B) has been transformed to the form (R D) where R is upper ! triangular and banded with bandwidth NB. The least squares ! system Rx = d is then easily solved using back substitution by ! executing the statement CALL DBNDSL(1,...). The sequence of ! values for JT must be nondecreasing. This may require some ! preliminary interchanges of rows and columns of the matrix A. ! ! The primary reason for these subroutines is that the total ! processing can take place in a working array of dimension MU by ! NB+1. An acceptable value for MU is ! ! MU = MAX(MT + N + 1), ! ! where N is the number of unknowns. ! ! Here the maximum is taken over all values of MT for T=1,...,Q. ! Notice that MT can be taken to be a small as one, showing that ! MU can be as small as N+2. The subprogram DBNDAC processes the ! rows more efficiently if MU is large enough so that each new ! block (C F) has a distinct value of JT. ! ! The four principle parts of these algorithms are obtained by the ! following call statements: ! ! * `CALL [[DBNDAC]](...)` Introduce new blocks of data. ! * `CALL [[DBNDSL]](1,...)` Compute solution vector and length of ! residual vector. ! * `CALL [[DBNDSL]](2,...)` Given any row vector H solve YR = H for the ! row vector Y. ! * `CALL [[DBNDSL]](3,...)` Given any column vector W solve RZ = W for ! the column vector Z. ! !### Remarks ! ! To obtain the upper triangular matrix and transformed right-hand ! side vector D so that the super diagonals of R form the columns ! of G(*,*), execute the following Fortran statements. ! !```fortran ! nbp1=nb+1 ! do j=1, nbp1 ! g(ir,j) = 0.0 ! end do ! mt=1 ! jt=n+1 ! call dbndac(g,mdg,nb,ip,ir,mt,jt) !``` ! !### References ! ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974, Chapter 27. ! !### Revision history ! * 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dbndac ( g , Mdg , Nb , Ip , Ir , Mt , Jt ) implicit none integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of MDG should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. real ( wp ), intent ( inout ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! *Input* !! The working array into which the user will !! place the `MT` by `NB+1` block `(C F)` in rows `IR` !! through `IR+MT-1`, columns 1 through `NB+1`. !! See descriptions of `IR` and `MT` below. !! !! *Output* !! The working array which will contain the !! processed rows of that part of the data !! matrix which has been passed to [[DBNDAC]]. integer , intent ( in ) :: Nb !! The bandwidth of the data matrix `A`. integer , intent ( inout ) :: Ip !! *Input* !! Set by the user to the value 1 before the !! first call to [[DBNDAC]]. Its subsequent value !! is controlled by [[DBNDAC]] to set up for the !! next call to [[DBNDAC]]. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( inout ) :: Ir !! *Input* !! Index of the row of `G(*,*)` where the user is !! to place the new block of data `(C F)`. Set by !! the user to the value 1 before the first call !! to [[DBNDAC]]. Its subsequent value is controlled !! by [[DBNDAC]]. A value of `IR > MDG` is considered !! an error. !! !! *Output* !! The value of this argument is advanced by !! [[DBNDAC]] to be ready for storing and processing !! a new block of data in `G(*,*)`. integer , intent ( in ) :: Mt !! Set by the user to indicate the !! number of new rows of data in the block integer , intent ( in ) :: Jt !! Set by the user to indicate !! the index of the first nonzero column in that !! set of rows `(E F) = (0 C 0 F)` being processed. real ( wp ) :: rho integer :: i , ie , ig , ig1 , ig2 , iopt , j , jg , & k , kh , l , lp1 , mh , mu , nbp1 , nerr real ( wp ), parameter :: zero = 0.0_wp ! ALG. STEPS 1-4 ARE PERFORMED EXTERNAL TO THIS SUBROUTINE. nbp1 = Nb + 1 if ( Mt <= 0 . or . Nb <= 0 ) return if (. not . Mdg < Ir ) then if ( Jt /= Ip ) then if ( Jt > Ir ) then do i = 1 , Mt ig1 = Jt + Mt - i ig2 = Ir + Mt - i do j = 1 , nbp1 g ( ig1 , j ) = g ( ig2 , j ) end do end do ie = Jt - Ir do i = 1 , ie ig = Ir + i - 1 do j = 1 , nbp1 g ( ig , j ) = zero end do end do Ir = Jt end if mu = min ( Nb - 1 , Ir - Ip - 1 ) if ( mu /= 0 ) then do l = 1 , mu k = min ( l , Jt - Ip ) lp1 = l + 1 ig = Ip + l do i = lp1 , Nb jg = i - k g ( ig , jg ) = g ( ig , i ) end do do i = 1 , k jg = nbp1 - i g ( ig , jg ) = zero end do end do end if Ip = Jt end if mh = Ir + Mt - Ip kh = min ( nbp1 , mh ) do i = 1 , kh call dh12 ( 1 , i , max ( i + 1 , Ir - Ip + 1 ), mh , g ( Ip , i ), 1 , & rho , g ( Ip , i + 1 ), 1 , Mdg , nbp1 - i ) end do Ir = Ip + kh if ( kh >= nbp1 ) then do i = 1 , Nb g ( Ir - 1 , i ) = zero end do end if else nerr = 1 iopt = 2 write ( * , * ) 'MDG ! These subroutines solve the least squares problem `Ax = b` for ! banded matrices A using sequential accumulation of rows of the ! data matrix. Exactly one right-hand side vector is permitted. ! ! See [[dbndac]] for a full description of how to use them. ! !### References ! ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974, Chapter 27. ! !### Revision history ! * 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dbndsl ( Mode , g , Mdg , Nb , Ip , Ir , x , n , Rnorm ) integer , intent ( in ) :: Mode !! Set by the user to one of the values 1, 2, or !! 3. These values respectively indicate that !! the solution of `AX = B`, `YR = H` or `RZ = W` is !! required. integer , intent ( in ) :: Mdg !! The number of rows in the working array !! `G(*,*)`. The value of `MDG` should be `>= MU`. !! The value of `MU` is defined in the abstract !! of these subprograms. !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( in ) :: g ( Mdg , * ) !! `G(MDG,NB+1)` !! !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Nb !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ip !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. integer , intent ( in ) :: Ir !! This argument has the same meaning and !! contents as following the last call to [[DBNDAC]]. real ( wp ), intent ( inout ) :: x ( * ) !! `X(N)` !! !! *Input* With mode=2 or 3 this array contains, !! respectively, the right-side vectors H or W of !! the systems YR = H or RZ = W. !! !! *Output* This array contains the solution vectors `X`, !! `Y` or `Z` of the systems `AX = B`, `YR = H` or !! `RZ = W` depending on the value of `MODE`=1, !! 2 or 3. integer , intent ( in ) :: n !! The number of variables in the solution !! vector. If any of the `N` diagonal terms are !! zero the subroutine [[DBNDSL]] prints an !! appropriate message. This condition is !! considered an error. real ( wp ), intent ( out ) :: Rnorm !! If `MODE=1`, `RNORM` is the Euclidean length of the !! residual vector `AX-B`. When `MODE=2` or `3` RNORM` !! is set to zero. real ( wp ) :: rsq , s integer :: i , i1 , i2 , ie , ii , iopt , irm1 , ix , j , & jg , l , nerr , np1 real ( wp ), parameter :: zero = 0.0_wp main : block Rnorm = zero select case ( Mode ) case ( 1 ) ! ALG. STEP 26 do j = 1 , n x ( j ) = g ( j , Nb + 1 ) end do rsq = zero np1 = n + 1 irm1 = Ir - 1 if ( np1 <= irm1 ) then do j = np1 , irm1 rsq = rsq + g ( j , Nb + 1 ) ** 2 end do Rnorm = sqrt ( rsq ) end if case ( 2 ) do j = 1 , n s = zero if ( j /= 1 ) then i1 = max ( 1 , j - Nb + 1 ) i2 = j - 1 do i = i1 , i2 l = j - i + 1 + max ( 0 , i - Ip ) s = s + x ( i ) * g ( i , l ) end do end if l = max ( 0 , j - Ip ) if ( g ( j , l + 1 ) == 0 ) exit main x ( j ) = ( x ( j ) - s ) / g ( j , l + 1 ) end do return end select ! MODE = 3 do ii = 1 , n i = n + 1 - ii s = zero l = max ( 0 , i - Ip ) if ( i /= n ) then ie = min ( n + 1 - i , Nb ) do j = 2 , ie jg = j + l ix = i - 1 + j s = s + g ( i , jg ) * x ( ix ) end do end if if ( g ( i , l + 1 ) == 0 ) exit main x ( i ) = ( x ( i ) - s ) / g ( i , l + 1 ) end do return end block main ! error handling nerr = 1 iopt = 2 write ( * , * ) 'A zero diagonal term is in the n by n upper triangular matrix.' end subroutine dbndsl !***************************************************************************************** !***************************************************************************************** !> ! Calculates the value of all possibly nonzero B-splines at `X` of ! order `MAX(JHIGH,(J+1)(INDEX-1))` on `T`. ! !### Revision history ! * 780801 DATE WRITTEN ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * JW : made threadsafe. See also [[dbspvn]] subroutine dfspvn ( t , Jhigh , Index , x , Ileft , Vnikx , j , deltam , deltap ) real ( wp ), intent ( in ) :: t ( * ) integer , intent ( in ) :: Jhigh integer , intent ( in ) :: Index real ( wp ), intent ( in ) :: x integer , intent ( in ) :: Ileft real ( wp ) :: Vnikx ( * ) integer , intent ( inout ) :: j !! JW : added real ( wp ), dimension ( 20 ), intent ( inout ) :: deltam , deltap !! JW : added real ( wp ) :: vm , vmprev integer :: imjp1 , ipj , jp1 , jp1ml , l if ( Index /= 2 ) then j = 1 Vnikx ( 1 ) = 1.0_wp if ( j >= Jhigh ) return end if do ipj = Ileft + j deltap ( j ) = t ( ipj ) - x imjp1 = Ileft - j + 1 deltam ( j ) = x - t ( imjp1 ) vmprev = 0.0_wp jp1 = j + 1 do l = 1 , j jp1ml = jp1 - l vm = Vnikx ( l ) / ( deltap ( l ) + deltam ( jp1ml )) Vnikx ( l ) = vm * deltap ( l ) + vmprev vmprev = vm * deltam ( jp1ml ) end do Vnikx ( jp1 ) = vmprev j = jp1 if ( j >= Jhigh ) exit end do end subroutine dfspvn !***************************************************************************************** !***************************************************************************************** !> ! Construction and/or application of a single ! Householder transformation. `Q = I + U*(U**T)/B` ! !### Reference ! ! * C.L.Lawson and R.J.Hanson, Jet Propulsion Laboratory, 1973 Jun 12 ! to appear in 'Solving Least Squares Problems', Prentice-Hall, 1974 ! !### Revision history ! * 790101 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 900911 Added DDOT to real(wp) statement. (WRB) subroutine dh12 ( Mode , Lpivot , l1 , m , u , Iue , Up , c , Ice , Icv , Ncv ) integer , intent ( in ) :: Mode !! 1 or 2 to select algorithm H1 or H2 . integer , intent ( in ) :: Lpivot !! the index of the pivot element. integer , intent ( in ) :: l1 !! If `L1 <= M` the transformation will be constructed to !! zero elements indexed from `L1` through `M`. If `L1 > M` !! the subroutine does an identity transformation. integer , intent ( in ) :: m !! see `l1` integer , intent ( in ) :: Iue !! the storage increment between elements of `U`. real ( wp ), intent ( inout ) :: u ( Iue , * ) !! On entry to H1 `U()` contains the pivot vector. !! On exit from H1 `U()` and `UP` !! contain quantities defining the vector `U` of the !! Householder transformation. On entry to H2 `U()` !! and `UP` should contain quantities previously computed !! by H1. These will not be modified by H2. real ( wp ), intent ( inout ) :: Up !! see `u` real ( wp ), intent ( inout ) :: c ( * ) !! On entry to H1 or H2 `C()` contains a matrix which will be !! regarded as a set of vectors to which the Householder !! transformation is to be applied. On exit `C()` contains the !! set of transformed vectors. integer , intent ( in ) :: Ice !! Storage increment between elements of vectors in `C()`. integer , intent ( in ) :: Icv !! Storage increment between vectors in `C()`. integer , intent ( in ) :: Ncv !! Number of vectors in `C()` to be transformed. If `NCV <= 0` !! no operations will be done on `C()`. integer :: i , i2 , i3 , i4 , incr , j , kl1 , & kl2 , klp , l1m1 , mml1p2 real ( wp ) :: b , cl , clinv , ul1m1 , sm real ( wp ), parameter :: one = 1.0_wp if ( 0 < Lpivot . and . Lpivot < l1 . and . l1 <= m ) then cl = abs ( u ( 1 , Lpivot )) if ( Mode /= 2 ) then ! ****** CONSTRUCT THE TRANSFORMATION. ****** do j = l1 , m cl = max ( abs ( u ( 1 , j )), cl ) end do if ( cl <= 0.0_wp ) return clinv = one / cl sm = ( u ( 1 , Lpivot ) * clinv ) ** 2 do j = l1 , m sm = sm + ( u ( 1 , j ) * clinv ) ** 2 end do cl = cl * sqrt ( sm ) if ( u ( 1 , Lpivot ) > 0.0_wp ) cl = - cl Up = u ( 1 , Lpivot ) - cl u ( 1 , Lpivot ) = cl ! ****** APPLY THE TRANSFORMATION I+U*(U**T)/B TO C. ****** elseif ( cl <= 0.0_wp ) then return end if if ( Ncv > 0 ) then b = Up * u ( 1 , Lpivot ) ! B MUST BE NONPOSITIVE HERE. IF B = 0., RETURN. if ( b < 0.0_wp ) then b = one / b mml1p2 = m - l1 + 2 if ( mml1p2 <= 20 ) then i2 = 1 - Icv + Ice * ( Lpivot - 1 ) incr = Ice * ( l1 - Lpivot ) do j = 1 , Ncv i2 = i2 + Icv i3 = i2 + incr i4 = i3 sm = c ( i2 ) * Up do i = l1 , m sm = sm + c ( i3 ) * u ( 1 , i ) i3 = i3 + Ice end do if ( sm /= 0.0_wp ) then sm = sm * b c ( i2 ) = c ( i2 ) + sm * Up do i = l1 , m c ( i4 ) = c ( i4 ) + sm * u ( 1 , i ) i4 = i4 + Ice end do end if end do else l1m1 = l1 - 1 kl1 = 1 + ( l1m1 - 1 ) * Ice kl2 = kl1 klp = 1 + ( Lpivot - 1 ) * Ice ul1m1 = u ( 1 , l1m1 ) u ( 1 , l1m1 ) = Up if ( Lpivot /= l1m1 ) call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) do j = 1 , Ncv sm = ddot ( mml1p2 , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) sm = sm * b call daxpy ( mml1p2 , sm , u ( 1 , l1m1 ), Iue , c ( kl1 ), Ice ) kl1 = kl1 + Icv end do u ( 1 , l1m1 ) = ul1m1 if ( Lpivot /= l1m1 ) then kl1 = kl2 call dswap ( Ncv , c ( kl1 ), Icv , c ( klp ), Icv ) end if end if end if end if end if end subroutine dh12 !***************************************************************************************** !***************************************************************************************** !> ! Sort an array and optionally make the same interchanges in ! an auxiliary array. The array may be sorted in increasing ! or decreasing order. ! !### History ! * 29-dec-2022 : Replaced original routines. ! Now just a wraper for [[sort_ascending]] recursive quicksort (JW) subroutine dsort ( n , Kflag , Dx , Dy ) implicit none integer , intent ( in ) :: n !! number of values in array DX to be sorted integer , intent ( in ) :: Kflag !! control parameter: !! * Kflag < 0 : sort DX in decreasing order and optionally carry DY along. !! * Kflag > 0 : sort DX in increasing order and optionally carry DY along. real ( wp ), dimension ( * ), intent ( inout ) :: Dx !! array of values to be sorted (usually abscissas) real ( wp ), dimension ( * ), intent ( inout ), optional :: Dy !! array to be (optionally) carried along if ( n < 1 ) then write ( * , * ) 'The number of values to be sorted is not positive.' return end if if ( abs ( Kflag ) == 0 ) then write ( * , * ) 'The sort control parameter, K, cannot be 0.' return end if ! Alter array DX to get decreasing order if needed if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) call sort_ascending ( n , Dx , Dy ) if ( Kflag < 0 ) Dx ( 1 : n ) = - Dx ( 1 : n ) end subroutine dsort !***************************************************************************************** !***************************************************************************************** !> ! Recursive quicksoft. ! Modified to also carry along a second array. ! !### Author ! * Jacob Williams subroutine sort_ascending ( n , dx , dy ) integer , intent ( in ) :: n real ( wp ), dimension ( * ), intent ( inout ) :: dx !! array of values to be sorted real ( wp ), dimension ( * ), intent ( inout ), optional :: dy !! array to be (optionally) carried along logical :: carry_dy !! if `dy` is to be also sorted integer , parameter :: max_size_for_insertion_sort = 20 !! max size for using insertion sort. !! (otherwise, use quicksort) carry_dy = present ( dy ) call quicksort ( 1 , n ) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array (ascending order). integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer :: ipivot !! pivot element integer :: i !! counter integer :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( dx ( j ) < dx ( j - 1 )) then call swap ( dx ( j ), dx ( j - 1 )) if ( carry_dy ) call swap ( dy ( j ), dy ( j - 1 )) else exit end if end do end do else if ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1 ) call quicksort ( ipivot + 1 , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array integer , intent ( in ) :: ilow integer , intent ( in ) :: ihigh integer , intent ( out ) :: ipivot integer :: i , ip , im im = ( ilow + ihigh ) / 2 call swap ( dx ( ilow ), dx ( im )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( im )) ip = ilow do i = ilow + 1 , ihigh if ( dx ( i ) < dx ( ilow )) then ip = ip + 1 call swap ( dx ( ip ), dx ( i )) if ( carry_dy ) call swap ( dy ( ip ), dy ( i )) end if end do call swap ( dx ( ilow ), dx ( ip )) if ( carry_dy ) call swap ( dy ( ilow ), dy ( ip )) ipivot = ip end subroutine partition subroutine swap ( v1 , v2 ) !! swap two real values real ( wp ), intent ( inout ) :: v1 real ( wp ), intent ( inout ) :: v2 real ( wp ) :: tmp tmp = v1 v1 = v2 v2 = tmp end subroutine swap end subroutine sort_ascending !***************************************************************************************** !***************************************************************************************** !> ! This subprogram fits a piecewise polynomial curve ! to discrete data. The piecewise polynomials are ! represented as B-splines. ! The fitting is done in a weighted least squares sense. ! Equality and inequality constraints can be imposed on the ! fitted curve. ! !### Evaluating the Variance Function ! ! To evaluate the variance function (assuming ! that the uncertainties of the Y values were ! provided to [[DFC]] and an input value of ! MODE=2 or 4 was used), use the function ! subprogram [[DCV]] ! !```fortran ! var = dcv(xval,ndata,nconst,nord,nbkpt, bkpt,w) !``` ! ! Here XVAL is the point where the variance is ! desired. The other arguments have the same ! meaning as in the usage of [[DFC]]. ! ! For those users employing the old problem ! designation, let MDATA be the number of data ! points in the problem. (This may be different ! from NDATA if the old problem designation ! feature was used.) The value, VAR, should be ! multiplied by the quantity ! ! `DBLE(MAX(NDATA-N,1))/DBLE(MAX(MDATA-N,1))` ! ! The output of this subprogram is not defined ! if an input value of MODE=1 or 3 was used in ! FC( ) or if an output value of MODE=-1, 2, or ! 3 was obtained. The variance function, except ! for the scaling factor noted above, is given ! by ! ! `VAR=(transpose of B(XVAL))*C*B(XVAL)` ! ! The vector B(XVAL) is the B-spline basis ! function values at X=XVAL. ! The covariance matrix, C, of the solution ! coefficients accounts only for the least ! squares equations and the explicitly stated ! equality constraints. This fact must be ! considered when interpreting the variance ! function from a data fitting problem that has ! inequality constraints on the fitted curve. ! !### Evaluating the Fitted Curve ! ! * Refer to the [[defc]] header ! !### Revision history ! * 780801 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900510 Convert references to XERRWV to references to XERMSG. (RWC) ! * 900607 Editorial changes to Prologue to make Prologues for EFC, ! DEFC, FC, and DFC look as much the same as possible. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dfc ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , & nconst , xconst , yconst , nderiv , mode , coeff , w , iw ) integer , intent ( in ) :: ndata !! number of points (size of `xdata` and `ydata`). !! Any non-negative value of `NDATA` is allowed. !! A negative value of `NDATA` is an error. real ( wp ), intent ( in ) :: xdata ( * ) !! X data array. No sorting of `XDATA(*)` is required. real ( wp ), intent ( in ) :: ydata ( * ) !! Y data array. real ( wp ), intent ( in ) :: sddata ( * ) !! Y value standard deviation or uncertainty. !! A zero value for any entry of !! `SDDATA(*)` will weight that data point as 1. !! Otherwise the weight of that data point is !! the reciprocal of this entry. integer , intent ( in ) :: nord !! B-spline order. !! (The order of the spline is one more than the !! degree of the piecewise polynomial defined on !! each interval. This is consistent with the !! B-spline package convention. For example, !! `NORD=4` when we are using piecewise cubics.) !! `NORD` must be in the range `1 <= NORD <= 20`. integer , intent ( in ) :: Nbkpt !! The value of `NBKPT` must satisfy the condition `NBKPT >= 2*NORD`. real ( wp ), dimension ( * ), intent ( in ) :: Bkpt !! `NBKPT` knots of the B-spline. !! Normally the !! problem data interval will be included between !! the limits `BKPT(NORD)` and `BKPT(NBKPT-NORD+1)`. !! The additional end knots `BKPT(I),I=1,...,NORD-1` !! and `I=NBKPT-NORD+2,...,NBKPT`, are !! required to compute the functions used to fit !! the data. No sorting of `BKPT(*)` is required. !! Internal to [[DEFC]] the extreme end knots may !! be reduced and increased respectively to !! accommodate any data values that are exterior !! to the given knot values. The contents of !! `BKPT(*)` is not changed. integer , intent ( in ) :: nconst !! The number of conditions that constrain the !! B-spline is NCONST. A constraint is specified !! by an (X,Y) pair in the arrays XCONST(*) and !! YCONST(*), and by the type of constraint and !! derivative value encoded in the array !! NDERIV(*). real ( wp ), intent ( in ) :: xconst ( * ) !! X value of constraint. !! No sorting of XCONST(*) is required. real ( wp ), intent ( in ) :: yconst ( * ) !! Y value of constraint integer , intent ( in ) :: nderiv ( * ) !! The value of NDERIV(*) is !! determined as follows. Suppose the I-th !! constraint applies to the J-th derivative !! of the B-spline. (Any non-negative value of !! J < NORD is permitted. In particular the !! value J=0 refers to the B-spline itself.) !! For this I-th constraint, set !!``` !! XCONST(I)=X, !! YCONST(I)=Y, and !! NDERIV(I)=ITYPE+4*J, where !! !! ITYPE = 0, if (J-th deriv. at X) <= Y. !! = 1, if (J-th deriv. at X) >= Y. !! = 2, if (J-th deriv. at X) == Y. !! = 3, if (J-th deriv. at X) == !! (J-th deriv. at Y). !!``` !! (A value of NDERIV(I)=-1 will cause this !! constraint to be ignored. This subprogram !! feature is often useful when temporarily !! suppressing a constraint while still !! retaining the source code of the calling !! program.) integer , intent ( inout ) :: mode !! *Input* !! !! An input flag that directs the least squares !! solution method used by [[DFC]]. !! !! The variance function, referred to below, !! defines the square of the probable error of !! the fitted curve at any point, XVAL. !! This feature of [[DFC]] allows one to use the !! square root of this variance function to !! determine a probable error band around the !! fitted curve. !! !! * `=1` a new problem. No variance function. !! * `=2` a new problem. Want variance function. !! * `=3` an old problem. No variance function. !! * `=4` an old problem. Want variance function. !! !! Any value of MODE other than 1-4 is an error. !! !! The user with a new problem can skip directly !! to the description of the input parameters !! IW(1), IW(2). !! !! If the user correctly specifies the new or old !! problem status, the subprogram [[DFC]] will !! perform more efficiently. !! By an old problem it is meant that subprogram !! [[DFC]] was last called with this same set of !! knots, data points and weights. !! !! Another often useful deployment of this old !! problem designation can occur when one has !! previously obtained a Q-R orthogonal !! decomposition of the matrix resulting from !! B-spline fitting of data (without constraints) !! at the breakpoints BKPT(I), I=1,...,NBKPT. !! For example, this matrix could be the result !! of sequential accumulation of the least !! squares equations for a very large data set. !! The user writes this code in a manner !! convenient for the application. For the !! discussion here let !! !! `N=NBKPT-NORD, and K=N+3` !! !! Let us assume that an equivalent least squares !! system !! !! `RC=D` !! !! has been obtained. Here R is an N+1 by N !! matrix and D is a vector with N+1 components. !! The last row of R is zero. The matrix R is !! upper triangular and banded. At most NORD of !! the diagonals are nonzero. !! The contents of R and D can be copied to the !! working array W(*) as follows. !! !! The I-th diagonal of R, which has N-I+1 !! elements, is copied to W(*) starting at !! !! `W((I-1)*K+1),` !! !! for I=1,...,NORD. !! The vector D is copied to W(*) starting at !! !! `W(NORD*K+1)` !! !! The input value used for NDATA is arbitrary !! when an old problem is designated. Because !! of the feature of [[DFC]] that checks the !! working storage array lengths, a value not !! exceeding NBKPT should be used. For example, !! use NDATA=0. !! !! (The constraints or variance function request !! can change in each call to [[DFC]].) A new !! problem is anything other than an old problem. !! !! *Output* !! !! An output flag that indicates the status !! of the constrained curve fit. !! !! * `=-1` a usage error of [[DFC]] occurred. The !! offending condition is noted with the !! SLATEC library error processor, XERMSG. !! In case the working arrays W(*) or IW(*) !! are not long enough, the minimal !! acceptable length is printed. !! * `= 0` successful constrained curve fit. !! * `= 1` the requested equality constraints !! are contradictory. !! * `= 2` the requested inequality constraints !! are contradictory. !! * `= 3` both equality and inequality constraints !! are contradictory. real ( wp ), intent ( out ) :: coeff ( * ) !! If the output value of MODE=0 or 1, this array !! contains the unknowns obtained from the least !! squares fitting process. These N=NBKPT-NORD !! parameters are the B-spline coefficients. !! For MODE=1, the equality constraints are !! contradictory. To make the fitting process !! more robust, the equality constraints are !! satisfied in a least squares sense. In this !! case the array COEFF(*) contains B-spline !! coefficients for this extended concept of a !! solution. If MODE=-1,2 or 3 on output, the !! array COEFF(*) is undefined. real ( wp ) :: w ( * ) !! real work array of length `IW(1)`. The !! contents of `W(*)` must not be modified by the !! user if the variance function is desired. !! !! The length of W(*) must be at least !!``` !! NB=(NBKPT-NORD+3)*(NORD+1)+ !! 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2 !!``` !! Whenever possible the code uses banded matrix !! processors DBNDAC( ) and DBNDSL( ). These !! are utilized if there are no constraints, !! no variance function is required, and there !! is sufficient data to uniquely determine the !! B-spline coefficients. If the band processors !! cannot be used to determine the solution, !! then the constrained least squares code DLSEI !! is used. In this case the subprogram requires !! an additional block of storage in W(*). For !! the discussion here define the integers NEQCON !! and NINCON respectively as the number of !! equality (ITYPE=2,3) and inequality !! (ITYPE=0,1) constraints imposed on the fitted !! curve. Define !! !! `L = NBKPT-NORD+1` !! !! and note that !! !! `NCONST = NEQCON+NINCON` !! !! When the subprogram [[DFC]] uses [[DLSEI]] the !! length of the working array W(*) must be at !! least !! !! `LW = NB+(L+NCONST)*L+2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6)` integer :: iw ( * ) !! integer work array of length `IW(2)` !! !! `IW(1),IW(2)` are the amounts of working storage actually !! allocated for the working arrays W(*) and !! IW(*). These quantities are compared with the !! actual amounts of storage needed in [[DFC]]. !! Insufficient storage allocated for either !! W(*) or IW(*) is an error. This feature was !! included in [[DFC]] because misreading the !! storage formulas for W(*) and IW(*) might very !! well lead to subtle and hard-to-find !! programming bugs. !! !! The length of the array IW(*) must be at least !! !! `IW1 = NINCON+2*L` !! !! in any case. integer :: i1 , i2 , i3 , i4 , i5 , i6 , i7 , mdg , mdw mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst ! USAGE IN DFCMN( ) OF W(*).. ! I1,...,I2-1 G(*,*) ! I2,...,I3-1 XTEMP(*) ! I3,...,I4-1 PTEMP(*) ! I4,...,I5-1 BKPT(*) (LOCAL TO [[DFCMN]]) ! I5,...,I6-1 BF(*,*) ! I6,...,I7-1 W(*,*) ! I7,... WORK(*) FOR [[DLSEI]] i1 = 1 i2 = i1 + mdg * ( nord + 1 ) i3 = i2 + max ( ndata , nbkpt ) i4 = i3 + max ( ndata , nbkpt ) i5 = i4 + nbkpt i6 = i5 + nord * nord i7 = i6 + mdw * ( nbkpt - nord + 1 ) call dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , bkpt , nconst , & xconst , yconst , nderiv , mode , coeff , w ( i5 ), w ( i2 ), w ( i3 ), & w ( i4 ), w ( i1 ), mdg , w ( i6 ), mdw , w ( i7 ), iw ) end subroutine dfc !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DFC]]. ! The documentation for [[DFC]] has complete usage instructions. ! !### Revision history ! * 780801 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900328 Added TYPE section. (WRB) ! * 900510 Convert XERRWV calls to XERMSG calls. (RWC) ! * 900604 DP version created from SP version. (RWC) subroutine dfcmn ( ndata , xdata , ydata , sddata , nord , nbkpt , & bkptin , nconst , xconst , yconst , nderiv , mode , coeff , bf , xtemp , & ptemp , bkpt , g , mdg , w , mdw , work , iwork ) integer :: iwork ( * ), mdg , mdw , mode , nbkpt , nconst , ndata , nderiv ( * ), & nord real ( wp ) :: bf ( nord , * ), bkpt ( * ), bkptin ( * ), coeff ( * ), & g ( mdg , * ), ptemp ( * ), sddata ( * ), w ( mdw , * ), work ( * ), & xconst ( * ), xdata ( * ), xtemp ( * ), yconst ( * ), ydata ( * ) real ( wp ) :: prgopt ( 10 ), rnorm , rnorme , rnorml , xmax , & xmin , xval , yval integer :: i , idata , ideriv , ileft , intrvl , intw1 , ip , ir , irow , & itype , iw1 , iw2 , l , lw , mt , n , nb , neqcon , nincon , nordm1 , & nordp1 , np1 logical :: band , new , var character ( len = 8 ) :: xern1 integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! Analyze input. if ( nord < 1 . or . nord > 20 ) then write ( * , * ) 'IN DFC, THE ORDER OF THE B-SPLINE MUST BE 1 THRU 20.' mode = - 1 return elseif ( nbkpt < 2 * nord ) then write ( * , * ) 'IN DFC, THE NUMBER OF KNOTS MUST BE AT LEAST TWICE ' // & 'THE B-SPLINE ORDER.' mode = - 1 return endif if ( ndata < 0 ) then write ( * , * ) 'IN DFC, THE NUMBER OF DATA POINTS MUST BE NONNEGATIVE.' mode = - 1 return endif ! Amount of storage allocated for W(*), IW(*). iw1 = iwork ( 1 ) iw2 = iwork ( 2 ) nb = ( nbkpt - nord + 3 ) * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + & nord ** 2 ! See if sufficient storage has been allocated. if ( iw1 < nb ) then write ( xern1 , '(I8)' ) nb write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK NB = ' // xern1 mode = - 1 return endif select case ( mode ) case ( 1 ) band = . true . var = . false . new = . true . case ( 2 ) band = . false . var = . true . new = . true . case ( 3 ) band = . true . var = . false . new = . false . case ( 4 ) band = . false . var = . true . new = . false . case default write ( * , * ) 'IN DFC, INPUT VALUE OF MODE MUST BE 1-4.' mode = - 1 return end select mode = 0 ! Sort the breakpoints. call dcopy ( nbkpt , bkptin , 1 , bkpt , 1 ) call dsort ( nbkpt , 1 , bkpt ) ! Initialize variables. neqcon = 0 nincon = 0 do i = 1 , nconst l = nderiv ( i ) itype = mod ( l , 4 ) if ( itype < 2 ) then nincon = nincon + 1 else neqcon = neqcon + 1 endif end do ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp ! Compute the number of variables. n = nbkpt - nord np1 = n + 1 lw = nb + ( np1 + nconst ) * np1 + 2 * ( neqcon + np1 ) + ( nincon + np1 ) + & ( nincon + 2 ) * ( np1 + 6 ) intw1 = nincon + 2 * np1 ! Save interval containing knots. xmin = bkpt ( nord ) xmax = bkpt ( np1 ) ! Find the smallest referenced independent variable value in any ! constraint. do i = 1 , nconst xmin = min ( xmin , xconst ( i )) xmax = max ( xmax , xconst ( i )) end do nordm1 = nord - 1 nordp1 = nord + 1 ! Define the option vector PRGOPT(1-10) for use in [[DLSEI]]. prgopt ( 1 ) = 4 ! Set the covariance matrix computation flag. prgopt ( 2 ) = 1 if ( var ) then prgopt ( 3 ) = 1 else prgopt ( 3 ) = 0 endif ! Increase the rank determination tolerances for both equality ! constraint equations and least squares equations. prgopt ( 4 ) = 7 prgopt ( 5 ) = 4 prgopt ( 6 ) = 1.0e-4_wp prgopt ( 7 ) = 10 prgopt ( 8 ) = 5 prgopt ( 9 ) = 1.0e-4_wp prgopt ( 10 ) = 1 ! Turn off work array length checking in [[DLSEI]]. iwork ( 1 ) = 0 iwork ( 2 ) = 0 ! Initialize variables and analyze input. if ( new ) then ! To process least squares equations sort data and an array of ! pointers. call dcopy ( ndata , xdata , 1 , xtemp , 1 ) do i = 1 , ndata ptemp ( i ) = i end do if ( ndata > 0 ) then call dsort ( ndata , 2 , xtemp , ptemp ) xmin = min ( xmin , xtemp ( 1 )) xmax = max ( xmax , xtemp ( ndata )) endif ! Fix breakpoint array if needed. do i = 1 , nord bkpt ( i ) = min ( bkpt ( i ), xmin ) end do do i = np1 , nbkpt bkpt ( i ) = max ( bkpt ( i ), xmax ) end do ! Initialize parameters of banded matrix processor, DBNDAC( ). mt = 0 ip = 1 ir = 1 ileft = nord do idata = 1 , ndata ! Sorted indices are in PTEMP(*). l = ptemp ( idata ) xval = xdata ( l ) ! When interval changes, process equations in the last block. if ( xval >= bkpt ( ileft + 1 )) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 ! Move pointer up to have BKPT(ILEFT)<=XVAL, ! ILEFT= bkpt ( ileft + 1 ) . and . ileft < n ) then ileft = ileft + 1 else exit endif end do endif ! Obtain B-spline function value. call dfspvn ( bkpt , nord , 1 , xval , ileft , bf , & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ! Move row into place. irow = ir + mt mt = mt + 1 call dcopy ( nord , bf , 1 , g ( irow , 1 ), mdg ) g ( irow , nordp1 ) = ydata ( l ) ! Scale data if uncertainty is nonzero. if ( sddata ( l ) /= 0.0_wp ) call dscal ( nordp1 , 1.0_wp / sddata ( l ), & g ( irow , 1 ), mdg ) ! When staging work area is exhausted, process rows. if ( irow == mdg - 1 ) then call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) mt = 0 endif end do ! Process last block of equations. call dbndac ( g , mdg , nord , ip , ir , mt , ileft - nordm1 ) ! Last call to adjust block positioning. call dcopy ( nordp1 , [ 0.0_wp ], 0 , g ( ir , 1 ), mdg ) call dbndac ( g , mdg , nord , ip , ir , 1 , np1 ) endif band = band . and . nconst == 0 do i = 1 , n band = band . and . g ( i , 1 ) /= 0.0_wp end do ! Process banded least squares equations. if ( band ) then call dbndsl ( 1 , g , mdg , nord , ip , ir , coeff , n , rnorm ) return endif ! Check further for sufficient storage in working arrays. if ( iw1 < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR W(*). CHECK LW = ' // xern1 mode = - 1 return endif if ( iw2 < intw1 ) then write ( xern1 , '(I8)' ) intw1 write ( * , * ) 'IN DFC, INSUFFICIENT STORAGE FOR IW(*). CHECK IW1 = ' // xern1 mode = - 1 return endif ! Write equality constraints. ! Analyze constraint indicators for an equality constraint. neqcon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype > 1 ) then ideriv = l / 4 neqcon = neqcon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) call dcopy ( np1 , [ 0.0_wp ], 0 , w ( neqcon , 1 ), mdw ) call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( neqcon , ileft - nordm1 ), & mdw ) if ( itype == 2 ) then w ( neqcon , np1 ) = yconst ( idata ) else ileft = nord yval = yconst ( idata ) do if ( yval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , yval , ileft , bf , ideriv + 1 ) call daxpy ( nord , - 1.0_wp , bf ( 1 , ideriv + 1 ), 1 , & w ( neqcon , ileft - nordm1 ), mdw ) endif endif end do ! Transfer least squares data. do i = 1 , np1 irow = i + neqcon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) call dcopy ( min ( np1 - i , nord ), g ( i , 1 ), mdg , w ( irow , i ), mdw ) w ( irow , np1 ) = g ( i , nordp1 ) end do ! Write inequality constraints. ! Analyze constraint indicators for inequality constraints. nincon = 0 do idata = 1 , nconst l = nderiv ( idata ) itype = mod ( l , 4 ) if ( itype < 2 ) then ideriv = l / 4 nincon = nincon + 1 ileft = nord xval = xconst ( idata ) do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= n ) exit ileft = ileft + 1 end do call dfspvd ( bkpt , nord , xval , ileft , bf , ideriv + 1 ) irow = neqcon + np1 + nincon call dcopy ( n , [ 0.0_wp ], 0 , w ( irow , 1 ), mdw ) intrvl = ileft - nordm1 call dcopy ( nord , bf ( 1 , ideriv + 1 ), 1 , w ( irow , intrvl ), mdw ) if ( itype == 1 ) then w ( irow , np1 ) = yconst ( idata ) else w ( irow , np1 ) = - yconst ( idata ) call dscal ( nord , - 1.0_wp , w ( irow , intrvl ), mdw ) endif endif end do ! Solve constrained least squares equations. call dlsei ( w , mdw , neqcon , np1 , nincon , n , prgopt , coeff , rnorme , & rnorml , mode , work , iwork ) end subroutine dfcmn !***************************************************************************************** !***************************************************************************************** !> ! Calculates value and derivs of all B-splines which do not vanish at `X` ! ! Fill `VNIKX(J,IDERIV), J=IDERIV, ... ,K` with nonzero values of ! B-splines of order `K+1-IDERIV , IDERIV=NDERIV, ... ,1`, by repeated ! calls to [[DFSPVN]] ! !### Revision history ! * 780801 DATE WRITTEN ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 890911 Removed unnecessary intrinsics. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) subroutine dfspvd ( t , k , x , ileft , vnikx , nderiv ) real ( wp ) :: t ( * ) integer :: k real ( wp ) :: x integer :: ileft real ( wp ) :: vnikx ( k , * ) integer :: nderiv real ( wp ) :: a ( 20 , 20 ) integer :: ideriv , idervm , i , j , kmd , m , jm1 , ipkmd , l , jlow real ( wp ) :: fkmd , diff , v integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = 0.0_wp dfspvn_deltap = 0.0_wp call dfspvn ( t , k + 1 - nderiv , 1 , x , ileft , vnikx ( nderiv , nderiv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) if ( nderiv <= 1 ) return ideriv = nderiv do i = 2 , nderiv idervm = ideriv - 1 do j = ideriv , k vnikx ( j - 1 , idervm ) = vnikx ( j , ideriv ) end do ideriv = idervm call dfspvn ( t , 0 , 2 , x , ileft , vnikx ( ideriv , ideriv ),& dfspvn_j , dfspvn_deltam , dfspvn_deltap ) end do do i = 1 , k do j = 1 , k a ( i , j ) = 0.0_wp end do a ( i , i ) = 1.0_wp end do kmd = k do m = 2 , nderiv kmd = kmd - 1 fkmd = kmd i = ileft j = k do jm1 = j - 1 ipkmd = i + kmd diff = t ( ipkmd ) - t ( i ) if ( jm1 == 0 ) exit if ( diff /= 0.0_wp ) then do l = 1 , j a ( l , j ) = ( a ( l , j ) - a ( l , j - 1 )) / diff * fkmd end do end if j = jm1 i = i - 1 end do if ( diff /= 0.0_wp ) then a ( 1 , 1 ) = a ( 1 , 1 ) / diff * fkmd end if do i = 1 , k v = 0.0_wp jlow = max ( i , m ) do j = jlow , k v = a ( i , j ) * vnikx ( j , m ) + v end do vnikx ( i , m ) = v end do end do end subroutine dfspvd !***************************************************************************************** !***************************************************************************************** !> ! Solve a least squares problem for banded matrices using ! sequential accumulation of rows of the data matrix. ! Exactly one right-hand side vector is permitted. ! ! This subroutine solves a linear least squares problem or a set of ! linear least squares problems having the same matrix but different ! right-side vectors. The problem data consists of an M by N matrix ! A, an M by NB matrix B, and an absolute tolerance parameter TAU ! whose usage is described below. The NB column vectors of B ! represent right-side vectors for NB distinct linear least squares ! problems. ! ! This set of problems can also be written as the matrix least ! squares problem ! ! `A = B`, ! ! where X is the N by NB solution matrix. ! ! Note that if B is the M by M identity matrix, then X will be the ! pseudo-inverse of A. ! ! This subroutine first transforms the augmented matrix (A B) to a ! matrix (R C) using premultiplying Householder transformations with ! column interchanges. All subdiagonal elements in the matrix R are ! zero and its diagonal elements satisfy ! !``` ! abs(r(i,i))>=abs(r(i+1,i+1)), ! i = 1,...,l-1, where ! l = min(m,n). !``` ! ! The subroutine will compute an integer, KRANK, equal to the number ! of diagonal terms of R that exceed TAU in magnitude. Then a ! solution of minimum Euclidean length is computed using the first ! KRANK rows of (R C). ! ! To be specific we suggest that the user consider an easily ! computable matrix norm, such as, the maximum of all column sums of ! magnitudes. ! ! Now if the relative uncertainty of B is EPS, (norm of uncertainty/ ! norm of B), it is suggested that TAU be set approximately equal to ! EPS*(norm of A). ! !### References ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974, Chapter 14. ! !### Revision history ! * 790101 DATE WRITTEN. Lawson, C. L., (JPL), Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 901005 Replace usage of DDIFF with usage of D1MACH. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dhfti ( a , mda , m , n , b , mdb , nb , tau , krank , rnorm , h , g , ip ) integer , intent ( in ) :: mda !! actual leading dimension of `a` integer , intent ( in ) :: mdb !! actual leading dimension of `b` real ( wp ), intent ( inout ) :: a ( mda , * ) !! `A(MDA,N)`. !! The array A(*,*) initially contains the M by N !! matrix A of the least squares problem AX = B. !! The first dimensioning parameter of the array !! A(*,*) is MDA, which must satisfy MDA>=M !! Either M>=N or M0 !! the array B(*) must initially contain the M by !! NB matrix B of the least squares problem AX = !! B. If NB>=2 the array B(*) must be doubly !! subscripted with first dimensioning parameter !! MDB>=MAX(M,N). If NB = 1 the array B(*) may !! be either doubly or singly subscripted. In !! the latter case the value of MDB is arbitrary !! but it should be set to some valid integer !! value such as MDB = M. !! !! The condition of NB>1.AND.MDB< MAX(M,N) !! is considered an error. !! !! On return the array B(*) will contain the N by !! NB solution matrix X. integer , intent ( in ) :: nb real ( wp ), intent ( in ) :: tau !! Absolute tolerance parameter provided by user !! for pseudorank determination. integer , intent ( out ) :: krank !! Set by the subroutine to indicate the !! pseudorank of A. real ( wp ), intent ( out ) :: rnorm ( * ) !! `RNORM(NB)`. !! On return, RNORM(J) will contain the Euclidean !! norm of the residual vector for the problem !! defined by the J-th column vector of the array !! B(*,*) for J = 1,...,NB. real ( wp ) :: h ( * ) !! `H(N)`. Array of working space used by DHFTI. !! On return, contains !! elements of the pre-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. real ( wp ) :: g ( * ) !! `G(N)`. Array of working space used by DHFTI. !! On return, contain !! elements of the post-multiplying !! Householder transformations used to compute !! the minimum Euclidean length solution. !! not generally required by the user. integer :: ip ( * ) !! `IP(N)`. Array of working space used by DHFTI. !! Array in which the subroutine records indices !! describing the permutation of column vectors. !! not generally required by the user. integer :: i , ii , iopt , ip1 , j , jb , jj , k , kp1 , l , ldiag , lmax , nerr real ( wp ) :: dzero , factor , hmax , sm , sm1 , szero , tmp logical :: lmax_found szero = 0.0_wp dzero = 0.0_wp factor = 0.001_wp k = 0 ldiag = min ( m , n ) if ( ldiag > 0 ) then if ( mda < m ) then nerr = 1 iopt = 2 write ( * , * ) 'MDA 1 . and . max ( m , n ) > mdb ) then nerr = 2 iopt = 2 write ( * , * ) 'MDB1. PROBABLE ERROR.' return end if do j = 1 , ldiag lmax_found = . false . if ( j /= 1 ) then ! UPDATE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = h ( l ) - a ( j - 1 , l ) ** 2 if ( h ( l ) > h ( lmax )) lmax = l end do lmax_found = ( factor * h ( lmax ) > hmax * drelpr ) end if if (. not . lmax_found ) then ! COMPUTE SQUARED COLUMN LENGTHS AND FIND LMAX lmax = j do l = j , n h ( l ) = 0.0_wp do i = j , m h ( l ) = h ( l ) + a ( i , l ) ** 2 end do if ( h ( l ) > h ( lmax )) lmax = l end do hmax = h ( lmax ) end if ! LMAX HAS BEEN DETERMINED ! DO COLUMN INTERCHANGES IF NEEDED. ip ( j ) = lmax if ( ip ( j ) /= j ) then do i = 1 , m tmp = a ( i , j ) a ( i , j ) = a ( i , lmax ) a ( i , lmax ) = tmp end do h ( lmax ) = h ( j ) end if ! COMPUTE THE J-TH TRANSFORMATION AND APPLY IT TO A ! AND B. call dh12 ( 1 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), a ( 1 , j + 1 ), 1 , mda , n - j ) call dh12 ( 2 , j , j + 1 , m , a ( 1 , j ), 1 , h ( j ), b , 1 , mdb , nb ) end do ! DETERMINE THE PSEUDORANK, K, USING THE TOLERANCE, TAU. do j = 1 , ldiag if ( abs ( a ( j , j )) <= tau ) then k = j - 1 exit else if ( j == ldiag ) k = ldiag end if end do kp1 = k + 1 ! COMPUTE THE NORMS OF THE RESIDUAL VECTORS. if ( nb >= 1 ) then do jb = 1 , nb tmp = szero if ( m >= kp1 ) then do i = kp1 , m tmp = tmp + b ( i , jb ) ** 2 end do end if rnorm ( jb ) = sqrt ( tmp ) end do end if ! SPECIAL FOR PSEUDORANK = 0 if ( k > 0 ) then ! IF THE PSEUDORANK IS LESS THAN N COMPUTE HOUSEHOLDER ! DECOMPOSITION OF FIRST K ROWS. if ( k /= n ) then do ii = 1 , k i = kp1 - ii call dh12 ( 1 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), a , mda , 1 , i - 1 ) end do end if if ( nb >= 1 ) then do jb = 1 , nb ! SOLVE THE K BY K TRIANGULAR SYSTEM. do l = 1 , k sm = dzero i = kp1 - l ip1 = i + 1 if ( k >= ip1 ) then do j = ip1 , k sm = sm + a ( i , j ) * b ( j , jb ) end do end if sm1 = sm b ( i , jb ) = ( b ( i , jb ) - sm1 ) / a ( i , i ) end do ! COMPLETE COMPUTATION OF SOLUTION VECTOR. if ( k /= n ) then do j = kp1 , n b ( j , jb ) = szero end do do i = 1 , k call dh12 ( 2 , i , kp1 , n , a ( i , 1 ), mda , g ( i ), b ( 1 , jb ), 1 , mdb , 1 ) end do end if ! RE-ORDER THE SOLUTION VECTOR TO COMPENSATE FOR THE ! COLUMN INTERCHANGES. do jj = 1 , ldiag j = ldiag + 1 - jj if ( ip ( j ) /= j ) then l = ip ( j ) tmp = b ( l , jb ) b ( l , jb ) = b ( j , jb ) b ( j , jb ) = tmp end if end do end do end if elseif ( nb >= 1 ) then do jb = 1 , nb do i = 1 , n b ( i , jb ) = szero end do end do end if end if ! THE SOLUTION VECTORS, X, ARE NOW ! IN THE FIRST N ROWS OF THE ARRAY B(,). krank = k end subroutine dhfti !***************************************************************************************** !***************************************************************************************** !> ! Determine an N1-vector W, and ! an N2-vector Z ! which minimizes the Euclidean length of W ! subject to G*W+H*Z >= Y. ! This is the least projected distance problem, LPDP. ! The matrices G and H are of respective ! dimensions M by N1 and M by N2. ! ! Called by subprogram [[DLSI]]. ! !``` ! The matrix ! (G H Y) ! ! occupies rows 1,...,M and cols 1,...,N1+N2+1 of A(*,*). ! ! The solution (W) is returned in X(*). ! (Z) !``` ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 910408 Updated the AUTHOR section. (WRB) subroutine dlpdp ( a , mda , m , n1 , n2 , prgopt , x , wnorm , mode , ws , is ) integer , intent ( in ) :: mda integer :: m integer , intent ( in ) :: n1 integer , intent ( in ) :: n2 real ( wp ) :: a ( mda , * ) !! `A(MDA,N+1)`, where `N=N1+N2`. real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) !! `X(N)`, where `N=N1+N2`. real ( wp ) :: wnorm integer , intent ( out ) :: mode !! The value of MODE indicates the status of !! the computation after returning to the user. !! !! * `MODE=1` The solution was successfully obtained. !! * `MODE=2` The inequalities are inconsistent. real ( wp ) :: ws ( * ) !! `WS((M+2)*(N+7))`, where `N=N1+N2`. This is a slight overestimate for WS(*). integer :: is ( * ) !! `IS(M+N+1)`, where `N=N1+N2`. integer :: i , iw , ix , j , l , modew , n , np1 real ( wp ) :: rnorm , sc , ynorm real ( wp ), parameter :: zero = 0.0_wp real ( wp ), parameter :: one = 1.0_wp real ( wp ), parameter :: fac = 0.1_wp n = n1 + n2 mode = 1 if ( m <= 0 ) then if ( n > 0 ) then x ( 1 ) = zero call dcopy ( n , x , 0 , x , 1 ) end if wnorm = zero return end if np1 = n + 1 ! SCALE NONZERO ROWS OF INEQUALITY MATRIX TO HAVE LENGTH ONE. do i = 1 , m sc = dnrm2 ( n , a ( i , 1 ), mda ) if ( sc /= zero ) then sc = one / sc call dscal ( np1 , sc , a ( i , 1 ), mda ) end if end do ! SCALE RT.-SIDE VECTOR TO HAVE LENGTH ONE (OR ZERO). ynorm = dnrm2 ( m , a ( 1 , np1 ), 1 ) if ( ynorm /= zero ) then sc = one / ynorm call dscal ( m , sc , a ( 1 , np1 ), 1 ) end if ! SCALE COLS OF MATRIX H. j = n1 + 1 do if ( j > n ) exit sc = dnrm2 ( m , a ( 1 , j ), 1 ) if ( sc /= zero ) sc = one / sc call dscal ( m , sc , a ( 1 , j ), 1 ) x ( j ) = sc j = j + 1 end do if ( n1 > 0 ) then ! COPY TRANSPOSE OF (H G Y) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m ! MOVE COL OF TRANSPOSE OF H INTO WORK ARRAY. call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ! MOVE COL OF TRANSPOSE OF G INTO WORK ARRAY. call dcopy ( n1 , a ( i , 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n1 ! MOVE COMPONENT OF VECTOR Y INTO WORK ARRAY. ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n ws ( iw + 1 ) = one iw = iw + 1 ! SOLVE EU=F SUBJECT TO (TRANSPOSE OF H)U=0, U>=0. THE ! MATRIX E = TRANSPOSE OF (G Y), AND THE (N+1)-VECTOR ! F = TRANSPOSE OF (0,...,0,1). ix = iw + 1 iw = iw + m ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , np1 , n2 , np1 - n2 , m , 0 , prgopt , ws ( ix ), rnorm , & modew , is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY W. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n1 x ( j ) = sc * ddot ( m , a ( 1 , j ), 1 , ws ( ix ), 1 ) end do ! COMPUTE THE VECTOR Q=Y-GW. OVERWRITE Y WITH THIS ! VECTOR. do i = 1 , m a ( i , np1 ) = a ( i , np1 ) - ddot ( n1 , a ( i , 1 ), mda , x , 1 ) end do end if if ( n2 > 0 ) then ! COPY TRANSPOSE OF (H Q) TO WORK ARRAY WS(*). iw = 0 do i = 1 , m call dcopy ( n2 , a ( i , n1 + 1 ), mda , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = a ( i , np1 ) iw = iw + 1 end do ws ( iw + 1 ) = zero call dcopy ( n2 , ws ( iw + 1 ), 0 , ws ( iw + 1 ), 1 ) iw = iw + n2 ws ( iw + 1 ) = one iw = iw + 1 ix = iw + 1 iw = iw + m ! SOLVE RV=S SUBJECT TO V>=0. THE MATRIX R =(TRANSPOSE ! OF (H Q)), WHERE Q=Y-GW. THE (N2+1)-VECTOR S =(TRANSPOSE ! OF (0,...,0,1)). ! ! DO NOT CHECK LENGTHS OF WORK ARRAYS IN THIS USAGE OF ! DWNNLS( ). is ( 1 ) = 0 is ( 2 ) = 0 call dwnnls ( ws , n2 + 1 , 0 , n2 + 1 , m , 0 , prgopt , ws ( ix ), rnorm , modew , & is , ws ( iw + 1 )) ! COMPUTE THE COMPONENTS OF THE SOLN DENOTED ABOVE BY Z. sc = one - ddot ( m , a ( 1 , np1 ), 1 , ws ( ix ), 1 ) if ( one + fac * abs ( sc ) == one . or . rnorm <= zero ) then mode = 2 return end if sc = one / sc do j = 1 , n2 l = n1 + j x ( l ) = sc * ddot ( m , a ( 1 , l ), 1 , ws ( ix ), 1 ) * x ( l ) end do end if ! ACCOUNT FOR SCALING OF RT.-SIDE VECTOR IN SOLUTION. call dscal ( n , ynorm , x , 1 ) wnorm = dnrm2 ( n1 , x , 1 ) end subroutine dlpdp !***************************************************************************************** !***************************************************************************************** !> ! This subprogram solves a linearly constrained least squares ! problem with both equality and inequality constraints, and, if the ! user requests, obtains a covariance matrix of the solution ! parameters. ! ! Suppose there are given matrices E, A and G of respective ! dimensions ME by N, MA by N and MG by N, and vectors F, B and H of ! respective lengths ME, MA and MG. This subroutine solves the ! linearly constrained least squares problem ! ! * `EX = F, (E ME by N)` (equations to be exactly satisfied) ! * `AX = B, (A MA by N)` (equations to be approximately satisfied, least squares sense) ! * `GX >= H,(G MG by N)` (inequality constraints) ! ! The inequalities GX >= H mean that every component of the ! product GX must be >= the corresponding component of H. ! ! In case the equality constraints cannot be satisfied, a ! generalized inverse solution residual vector length is obtained ! for F-EX. This is the minimal length possible for F-EX. ! ! Any values ME >= 0, MA >= 0, or MG >= 0 are permitted. The ! rank of the matrix E is estimated during the computation. We call ! this value KRANKE. It is an output parameter in IP(1) defined ! below. Using a generalized inverse solution of EX=F, a reduced ! least squares problem with inequality constraints is obtained. ! The tolerances used in these tests for determining the rank ! of E and the rank of the reduced least squares problem are ! given in Sandia Tech. Rept. SAND-78-1290. They can be ! modified by the user if new values are provided in ! the option list of the array PRGOPT(*). ! ! The user must dimension all arrays appearing in the call list.. ! W(MDW,N+1),PRGOPT(*),X(N),WS(2*(ME+N)+K+(MG+2)*(N+7)),IP(MG+2*N+2) ! where K=MAX(MA+MG,N). This allows for a solution of a range of ! problems in the given working space. The dimension of WS(*) ! given is a necessary overestimate. Once a particular problem ! has been run, the output parameter IP(3) gives the actual ! dimension required for that problem. ! ! The parameters for [[DLSEI]] are ! !``` ! Input.. All TYPE REAL variables are DOUBLE PRECISION ! ! W(*,*),MDW, The array W(*,*) is doubly subscripted with ! ME,MA,MG,N first dimensioning parameter equal to MDW. ! For this discussion let us call M = ME+MA+MG. Then ! MDW must satisfy MDW >= M. The condition ! MDW < M is an error. ! ! The array W(*,*) contains the matrices and vectors ! ! (E F) ! (A B) ! (G H) ! ! in rows and columns 1,...,M and 1,...,N+1 ! respectively. ! ! The integers ME, MA, and MG are the ! respective matrix row dimensions ! of E, A and G. Each matrix has N columns. ! ! PRGOPT(*) This real-valued array is the option vector. ! If the user is satisfied with the nominal ! subprogram features set ! ! PRGOPT(1)=1 (or PRGOPT(1)=1.0) ! ! Otherwise PRGOPT(*) is a linked list consisting of ! groups of data of the following form ! ! LINK ! KEY ! DATA SET ! ! The parameters LINK and KEY are each one word. ! The DATA SET can be comprised of several words. ! The number of items depends on the value of KEY. ! The value of LINK points to the first ! entry of the next group of data within ! PRGOPT(*). The exception is when there are ! no more options to change. In that ! case, LINK=1 and the values KEY and DATA SET ! are not referenced. The general layout of ! PRGOPT(*) is as follows. ! ! ...PRGOPT(1) = LINK1 (link to first entry of next group) ! . PRGOPT(2) = KEY1 (key to the option change) ! . PRGOPT(3) = data value (data value for this change) ! . . ! . . ! . . ! ...PRGOPT(LINK1) = LINK2 (link to the first entry of ! . next group) ! . PRGOPT(LINK1+1) = KEY2 (key to the option change) ! . PRGOPT(LINK1+2) = data value ! ... . ! . . ! . . ! ...PRGOPT(LINK) = 1 (no more options to change) ! ! Values of LINK that are nonpositive are errors. ! A value of LINK > NLINK=100000 is also an error. ! This helps prevent using invalid but positive ! values of LINK that will probably extend ! beyond the program limits of PRGOPT(*). ! Unrecognized values of KEY are ignored. The ! order of the options is arbitrary and any number ! of options can be changed with the following ! restriction. To prevent cycling in the ! processing of the option array, a count of the ! number of options changed is maintained. ! Whenever this count exceeds NOPT=1000, an error ! message is printed and the subprogram returns. ! ! Options.. ! ! KEY=1 ! Compute in W(*,*) the N by N ! covariance matrix of the solution variables ! as an output parameter. Nominally the ! covariance matrix will not be computed. ! (This requires no user input.) ! The data set for this option is a single value. ! It must be nonzero when the covariance matrix ! is desired. If it is zero, the covariance ! matrix is not computed. When the covariance matrix ! is computed, the first dimensioning parameter ! of the array W(*,*) must satisfy MDW >= MAX(M,N). ! ! KEY=10 ! Suppress scaling of the inverse of the ! normal matrix by the scale factor RNORM**2/ ! MAX(1, no. of degrees of freedom). This option ! only applies when the option for computing the ! covariance matrix (KEY=1) is used. With KEY=1 and ! KEY=10 used as options the unscaled inverse of the ! normal matrix is returned in W(*,*). ! The data set for this option is a single value. ! When it is nonzero no scaling is done. When it is ! zero scaling is done. The nominal case is to do ! scaling so if option (KEY=1) is used alone, the ! matrix will be scaled on output. ! ! KEY=2 ! Scale the nonzero columns of the ! entire data matrix. ! (E) ! (A) ! (G) ! ! to have length one. The data set for this ! option is a single value. It must be ! nonzero if unit length column scaling ! is desired. ! ! KEY=3 ! Scale columns of the entire data matrix ! (E) ! (A) ! (G) ! ! with a user-provided diagonal matrix. ! The data set for this option consists ! of the N diagonal scaling factors, one for ! each matrix column. ! ! KEY=4 ! Change the rank determination tolerance for ! the equality constraint equations from ! the nominal value of SQRT(DRELPR). This quantity can ! be no smaller than DRELPR, the arithmetic- ! storage precision. The quantity DRELPR is the ! largest positive number such that T=1.+DRELPR ! satisfies T == 1. The quantity used ! here is internally restricted to be at ! least DRELPR. The data set for this option ! is the new tolerance. ! ! KEY=5 ! Change the rank determination tolerance for ! the reduced least squares equations from ! the nominal value of SQRT(DRELPR). This quantity can ! be no smaller than DRELPR, the arithmetic- ! storage precision. The quantity used ! here is internally restricted to be at ! least DRELPR. The data set for this option ! is the new tolerance. ! ! For example, suppose we want to change ! the tolerance for the reduced least squares ! problem, compute the covariance matrix of ! the solution parameters, and provide ! column scaling for the data matrix. For ! these options the dimension of PRGOPT(*) ! must be at least N+9. The Fortran statements ! defining these options would be as follows: ! ! PRGOPT(1)=4 (link to entry 4 in PRGOPT(*)) ! PRGOPT(2)=1 (covariance matrix key) ! PRGOPT(3)=1 (covariance matrix wanted) ! ! PRGOPT(4)=7 (link to entry 7 in PRGOPT(*)) ! PRGOPT(5)=5 (least squares equas. tolerance key) ! PRGOPT(6)=... (new value of the tolerance) ! ! PRGOPT(7)=N+9 (link to entry N+9 in PRGOPT(*)) ! PRGOPT(8)=3 (user-provided column scaling key) ! ! CALL DCOPY (N, D, 1, PRGOPT(9), 1) (Copy the N ! scaling factors from the user array D(*) ! to PRGOPT(9)-PRGOPT(N+8)) ! ! PRGOPT(N+9)=1 (no more options to change) ! ! The contents of PRGOPT(*) are not modified ! by the subprogram. ! The options for WNNLS( ) can also be included ! in this array. The values of KEY recognized ! by WNNLS( ) are 6, 7 and 8. Their functions ! are documented in the usage instructions for ! subroutine WNNLS( ). Normally these options ! do not need to be modified when using [[DLSEI]]. ! ! IP(1), The amounts of working storage actually ! IP(2) allocated for the working arrays WS(*) and ! IP(*), respectively. These quantities are ! compared with the actual amounts of storage ! needed by [[DLSEI]]. Insufficient storage ! allocated for either WS(*) or IP(*) is an ! error. This feature was included in [[DLSEI]] ! because miscalculating the storage formulas ! for WS(*) and IP(*) might very well lead to ! subtle and hard-to-find execution errors. ! ! The length of WS(*) must be at least ! ! LW = 2*(ME+N)+K+(MG+2)*(N+7) ! ! where K = max(MA+MG,N) ! This test will not be made if IP(1)<=0. ! ! The length of IP(*) must be at least ! ! LIP = MG+2*N+2 ! This test will not be made if IP(2)<=0. ! ! Output.. All TYPE REAL variables are DOUBLE PRECISION ! ! X(*),RNORME, The array X(*) contains the solution parameters ! RNORML if the integer output flag MODE = 0 or 1. ! The definition of MODE is given directly below. ! When MODE = 0 or 1, RNORME and RNORML ! respectively contain the residual vector ! Euclidean lengths of F - EX and B - AX. When ! MODE=1 the equality constraint equations EX=F ! are contradictory, so RNORME /= 0. The residual ! vector F-EX has minimal Euclidean length. For ! MODE >= 2, none of these parameters is defined. ! ! MODE Integer flag that indicates the subprogram ! status after completion. If MODE >= 2, no ! solution has been computed. ! ! MODE = ! ! 0 Both equality and inequality constraints ! are compatible and have been satisfied. ! ! 1 Equality constraints are contradictory. ! A generalized inverse solution of EX=F was used ! to minimize the residual vector length F-EX. ! In this sense, the solution is still meaningful. ! ! 2 Inequality constraints are contradictory. ! ! 3 Both equality and inequality constraints ! are contradictory. ! ! The following interpretation of ! MODE=1,2 or 3 must be made. The ! sets consisting of all solutions ! of the equality constraints EX=F ! and all vectors satisfying GX >= H ! have no points in common. (In ! particular this does not say that ! each individual set has no points ! at all, although this could be the ! case.) ! ! 4 Usage error occurred. The value ! of MDW is < ME+MA+MG, MDW is ! < N and a covariance matrix is ! requested, or the option vector ! PRGOPT(*) is not properly defined, ! or the lengths of the working arrays ! WS(*) and IP(*), when specified in ! IP(1) and IP(2) respectively, are not ! long enough. ! ! W(*,*) The array W(*,*) contains the N by N symmetric ! covariance matrix of the solution parameters, ! provided this was requested on input with ! the option vector PRGOPT(*) and the output ! flag is returned with MODE = 0 or 1. ! ! IP(*) The integer working array has three entries ! that provide rank and working array length ! information after completion. ! ! IP(1) = rank of equality constraint ! matrix. Define this quantity ! as KRANKE. ! ! IP(2) = rank of reduced least squares ! problem. ! ! IP(3) = the amount of storage in the ! working array WS(*) that was ! actually used by the subprogram. ! The formula given above for the length ! of WS(*) is a necessary overestimate. ! If exactly the same problem matrices ! are used in subsequent executions, ! the declared dimension of WS(*) can ! be reduced to this output value. ! User Designated ! Working Arrays.. ! ! WS(*),IP(*) These are respectively type real ! and type integer working arrays. ! Their required minimal lengths are ! given above. !``` ! !### References ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Report SAND77-0552, Sandia ! Laboratories, June 1978. ! * K. H. Haskell and R. J. Hanson, Selected algorithms for ! the linearly constrained least squares problem - a ! users guide, Report SAND78-1290, Sandia Laboratories, ! August 1979. ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Mathematical Programming ! 21 (1981), pp. 98-118. ! * R. J. Hanson and K. H. Haskell, Two algorithms for the ! linearly constrained least squares problem, ACM ! Transactions on Mathematical Software, September 1982. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 890831 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900510 Convert XERRWV calls to XERMSG calls. (RWC) ! * 900604 DP version created from SP version. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dlsei ( w , mdw , me , ma , mg , n , prgopt , x , rnorme , & rnorml , mode , ws , ip ) integer , intent ( in ) :: mdw real ( wp ) :: w ( mdw , * ) integer :: me integer :: ma integer :: mg integer :: n real ( wp ) :: prgopt ( * ) real ( wp ) :: x ( * ) real ( wp ) :: rnorme real ( wp ) :: rnorml integer :: mode real ( wp ) :: ws ( * ) integer :: ip ( 3 ) real ( wp ) :: enorm , fnorm , gam , rb , rn , rnmax , size , & sn , snmax , t , tau , uj , up , vj , xnorm , xnrme integer :: i , imax , j , jp1 , k , key , kranke , last , lchk , link , m , & mapke1 , mdeqc , mend , mep1 , n1 , n2 , next , nlink , nopt , np1 , & ntimes logical :: cov , done character ( len = 8 ) :: xern1 , xern2 , xern3 , xern4 ! Set the nominal tolerance used in the code for the equality ! constraint equations. tau = sqrt ( drelpr ) ! Check that enough storage was allocated in WS(*) and IP(*). mode = 4 if ( min ( n , me , ma , mg ) < 0 ) then write ( xern1 , '(I8)' ) n write ( xern2 , '(I8)' ) me write ( xern3 , '(I8)' ) ma write ( xern4 , '(I8)' ) mg write ( * , * ) 'ALL OF THE VARIABLES N, ME,' // & ' MA, MG MUST BE >= 0. ENTERED ROUTINE WITH: ' // & 'N = ' // trim ( adjustl ( xern1 )) // & ', ME = ' // trim ( adjustl ( xern2 )) // & ', MA = ' // trim ( adjustl ( xern3 )) // & ', MG = ' // trim ( adjustl ( xern4 )) return endif if ( ip ( 1 ) > 0 ) then lchk = 2 * ( me + n ) + max ( ma + mg , n ) + ( mg + 2 ) * ( n + 7 ) if ( ip ( 1 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WS(*), NEED LW = ' // xern1 return endif endif if ( ip ( 2 ) > 0 ) then lchk = mg + 2 * n + 2 if ( ip ( 2 ) < lchk ) then write ( xern1 , '(I8)' ) lchk write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IP(*), NEED LIP = ' // xern1 return endif endif ! Compute number of possible right multiplying Householder ! transformations. m = me + ma + mg if ( n <= 0 . or . m <= 0 ) then mode = 0 rnorme = 0 rnorml = 0 return endif if ( mdw < m ) then write ( * , * ) 'MDW < ME+MA+MG IS AN ERROR' return endif np1 = n + 1 kranke = min ( me , n ) n1 = 2 * kranke + 1 n2 = n1 + n ! Set nominal values. ! ! The nominal column scaling used in the code is ! the identity scaling. call dcopy ( n , [ 1.0_wp ], 0 , ws ( n1 ), 1 ) ! No covariance matrix is nominally computed. cov = . false . ! Process option vector. ! Define bound for number of options to change. nopt = 1000 ntimes = 0 ! Define bound for positive values of LINK. nlink = 100000 last = 1 link = prgopt ( 1 ) if ( link == 0 . or . link > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 1 ) then cov = prgopt ( last + 2 ) /= 0.0_wp elseif ( key == 2 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t ws ( j + n1 - 1 ) = t end do elseif ( key == 3 ) then call dcopy ( n , prgopt ( last + 2 ), 1 , ws ( n1 ), 1 ) elseif ( key == 4 ) then tau = max ( drelpr , prgopt ( last + 2 )) endif next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , ws ( n1 + j - 1 ), w ( 1 , j ), 1 ) end do if ( cov . and . mdw < n ) then write ( * , * ) 'MDW < N WHEN COV MATRIX NEEDED, IS AN ERROR' return endif ! Problem definition and option vector OK. mode = 0 ! Compute norm of equality constraint matrix and right side. enorm = 0.0_wp do j = 1 , n enorm = max ( enorm , dasum ( me , w ( 1 , j ), 1 )) end do fnorm = dasum ( me , w ( 1 , np1 ), 1 ) snmax = 0.0_wp rnmax = 0.0_wp do i = 1 , kranke ! Compute maximum ratio of vector lengths. Partition is at ! column I. do k = i , me sn = ddot ( n - i + 1 , w ( k , i ), mdw , w ( k , i ), mdw ) rn = ddot ( i - 1 , w ( k , 1 ), mdw , w ( k , 1 ), mdw ) if ( rn == 0.0_wp . and . sn > snmax ) then snmax = sn imax = k elseif ( k == i . or . sn * rnmax > rn * snmax ) then snmax = sn rnmax = rn imax = k endif end do ! Interchange rows if necessary. if ( i /= imax ) call dswap ( np1 , w ( i , 1 ), mdw , w ( imax , 1 ), mdw ) if ( snmax > rnmax * tau ** 2 ) then ! Eliminate elements I+1,...,N in row I. call dh12 ( 1 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), w ( i + 1 , 1 ), mdw , 1 , m - i ) else kranke = i - 1 exit endif end do ! Save diagonal terms of lower trapezoidal matrix. call dcopy ( kranke , w , mdw + 1 , ws ( kranke + 1 ), 1 ) ! Use Householder transformation from left to achieve ! KRANKE by KRANKE upper triangular form. if ( kranke < me ) then do k = kranke , 1 , - 1 ! Apply transformation to matrix cols. 1,...,K-1. call dh12 ( 1 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w , 1 , mdw , k - 1 ) ! Apply to rt side vector. call dh12 ( 2 , k , kranke + 1 , me , w ( 1 , k ), 1 , up , w ( 1 , np1 ), 1 , 1 , 1 ) end do endif ! Solve for variables 1,...,KRANKE in new coordinates. call dcopy ( kranke , w ( 1 , np1 ), 1 , x , 1 ) do i = 1 , kranke x ( i ) = ( x ( i ) - ddot ( i - 1 , w ( i , 1 ), mdw , x , 1 )) / w ( i , i ) end do ! Compute residuals for reduced problem. mep1 = me + 1 rnorml = 0.0_wp do i = mep1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( kranke , w ( i , 1 ), mdw , x , 1 ) sn = ddot ( kranke , w ( i , 1 ), mdw , w ( i , 1 ), mdw ) rn = ddot ( n - kranke , w ( i , kranke + 1 ), mdw , w ( i , kranke + 1 ), mdw ) if ( rn <= sn * tau ** 2 . and . kranke < n ) & call dcopy ( n - kranke , [ 0.0_wp ], 0 , w ( i , kranke + 1 ), mdw ) end do ! Compute equality constraint equations residual length. rnorme = dnrm2 ( me - kranke , w ( kranke + 1 , np1 ), 1 ) ! Move reduced problem data upward if KRANKE 0 ) then mdeqc = 0 xnrme = dasum ( kranke , w ( 1 , np1 ), 1 ) if ( rnorme > tau * ( enorm * xnrme + fnorm )) mdeqc = 1 mode = mode + mdeqc ! Check if solution to equality constraints satisfies inequality ! constraints when there are no degrees of freedom left. if ( kranke == n . and . mg > 0 ) then xnorm = dasum ( n , x , 1 ) mapke1 = ma + kranke + 1 mend = ma + kranke + mg do i = mapke1 , mend size = dasum ( n , w ( i , 1 ), mdw ) * xnorm + abs ( w ( i , np1 )) if ( w ( i , np1 ) > tau * size ) then mode = mode + 2 done = . true . exit endif end do endif endif if (. not . done ) then ! Replace diagonal terms of lower trapezoidal matrix. if ( kranke > 0 ) then call dcopy ( kranke , ws ( kranke + 1 ), 1 , w , mdw + 1 ) ! Reapply transformation to put solution in original coordinates. do i = kranke , 1 , - 1 call dh12 ( 2 , i , i + 1 , n , w ( i , 1 ), mdw , ws ( i ), x , 1 , 1 , 1 ) end do ! Compute covariance matrix of equality constrained problem. if ( cov ) then do j = min ( kranke , n - 1 ), 1 , - 1 rb = ws ( j ) * w ( j , j ) if ( rb /= 0.0_wp ) rb = 1.0_wp / rb jp1 = j + 1 do i = jp1 , n w ( i , j ) = rb * ddot ( n - j , w ( i , jp1 ), mdw , w ( j , jp1 ), mdw ) end do gam = 0.5_wp * rb * ddot ( n - j , w ( jp1 , j ), 1 , w ( j , jp1 ), mdw ) call daxpy ( n - j , gam , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) do i = jp1 , n do k = i , n w ( i , k ) = w ( i , k ) + w ( j , i ) * w ( k , j ) + w ( i , j ) * w ( j , k ) w ( k , i ) = w ( i , k ) end do end do uj = ws ( j ) vj = gam * uj w ( j , j ) = uj * vj + uj * vj do i = jp1 , n w ( j , i ) = uj * w ( i , j ) + vj * w ( j , i ) end do call dcopy ( n - j , w ( j , jp1 ), mdw , w ( jp1 , j ), 1 ) end do endif endif ! Apply the scaling to the covariance matrix. if ( cov ) then do i = 1 , n call dscal ( n , ws ( i + n1 - 1 ), w ( i , 1 ), mdw ) call dscal ( n , ws ( i + n1 - 1 ), w ( 1 , i ), 1 ) end do endif end if ! Rescale solution vector. if ( mode <= 1 ) then do j = 1 , n x ( j ) = x ( j ) * ws ( n1 + j - 1 ) end do endif ip ( 1 ) = kranke ip ( 3 ) = ip ( 3 ) + 2 * kranke + n end subroutine dlsei !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DLSEI]]. The documentation for ! [[DLSEI]] has complete usage instructions. ! ! Solve: !``` ! AX = B, A MA by N (least squares equations) !``` ! ! subject to: !``` ! GX>=H, G MG by N (inequality constraints) !``` ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and extensively revised (WRB & RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 900604 DP version created from SP version. (RWC) ! * 920422 Changed CALL to DHFTI to include variable MA. (WRB) subroutine dlsi ( w , mdw , ma , mg , n , prgopt , x , rnorm , mode , ws , ip ) integer , intent ( in ) :: mdw !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: ma !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: mg !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. integer , intent ( in ) :: n !! contain (resp) var. dimension of `W(*,*)`, and matrix dimensions. real ( wp ) :: w ( mdw , * ) !! `W(*,*)` contains: !! !!``` !! (A B) !! (G H) !!``` !! !! in rows `1,...,MA+MG`, !! cols `1,...,N+1`. real ( wp ), intent ( in ) :: prgopt ( * ) !! Program option vector. real ( wp ), intent ( out ) :: x ( * ) !! Solution vector(unless MODE=2) real ( wp ), intent ( out ) :: rnorm !! length of AX-B. integer , intent ( out ) :: mode !! * `=0` Inequality constraints are compatible. !! * `=2` Inequality constraints contradictory. real ( wp ) :: ws ( * ) !! Working storage of dimension `K+N+(MG+2)*(N+7)`, !! where `K=MAX(MA+MG,N)`. integer :: ip ( * ) !! `IP(MG+2*N+1)` Integer working storage real ( wp ) :: anorm , fac , gam , rb , tau , tol , xnorm integer :: i , j , k , key , krank , krm1 , krp1 , l , last , link , m , map1 , & mdlpdp , minman , n1 , n2 , n3 , next , np1 logical :: cov , sclcov real ( wp ) :: rnorm_ ( 1 ) !! JW added for call to [[dhfti]] ! Set the nominal tolerance used in the code. tol = sqrt ( drelpr ) mode = 0 rnorm = 0.0_wp m = ma + mg np1 = n + 1 krank = 0 main : block if ( n <= 0 . or . m <= 0 ) exit main ! To process option vector. cov = . false . sclcov = . true . last = 1 link = prgopt ( 1 ) do if ( link <= 1 ) exit key = prgopt ( last + 1 ) if ( key == 1 ) cov = prgopt ( last + 2 ) /= 0.0_wp if ( key == 10 ) sclcov = prgopt ( last + 2 ) == 0.0_wp if ( key == 5 ) tol = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) last = link link = next end do ! Compute matrix norm of least squares equations. anorm = 0.0_wp do j = 1 , n anorm = max ( anorm , dasum ( ma , w ( 1 , j ), 1 )) end do ! Set tolerance for DHFTI( ) rank test. tau = tol * anorm ! Compute Householder orthogonal decomposition of matrix. call dcopy ( n , [ 0.0_wp ], 0 , ws , 1 ) call dcopy ( ma , w ( 1 , np1 ), 1 , ws , 1 ) k = max ( m , n ) minman = min ( ma , n ) n1 = k + 1 n2 = n1 + n rnorm_ ( 1 ) = rnorm ! JW call dhfti ( w , mdw , ma , n , ws , ma , 1 , tau , krank , rnorm_ , ws ( n2 ), & ws ( n1 ), ip ) rnorm = rnorm_ ( 1 ) ! JW fac = 1.0_wp gam = ma - krank if ( krank < ma . and . sclcov ) fac = rnorm ** 2 / gam ! Reduce to DLPDP and solve. map1 = ma + 1 ! Compute inequality rt-hand side for DLPDP. if ( ma < m ) then if ( minman > 0 ) then do i = map1 , m w ( i , np1 ) = w ( i , np1 ) - ddot ( n , w ( i , 1 ), mdw , ws , 1 ) end do ! Apply permutations to col. of inequality constraint matrix. do i = 1 , minman call dswap ( mg , w ( map1 , i ), 1 , w ( map1 , ip ( i )), 1 ) end do ! Apply Householder transformations to constraint matrix. if ( krank > 0 . and . krank < n ) then do i = krank , 1 , - 1 call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & w ( map1 , 1 ), mdw , 1 , mg ) end do endif ! Compute permuted inequality constraint matrix times r-inv. do i = map1 , m do j = 1 , krank w ( i , j ) = ( w ( i , j ) - ddot ( j - 1 , w ( 1 , j ), 1 , w ( i , 1 ), mdw )) / w ( j , j ) end do end do endif ! Solve the reduced problem with DLPDP algorithm, ! the least projected distance problem. call dlpdp ( w ( map1 , 1 ), mdw , mg , krank , n - krank , prgopt , x , & xnorm , mdlpdp , ws ( n2 ), ip ( n + 1 )) ! Compute solution in original coordinates. if ( mdlpdp == 1 ) then do i = krank , 1 , - 1 x ( i ) = ( x ( i ) - ddot ( krank - i , w ( i , i + 1 ), mdw , x ( i + 1 ), 1 )) / w ( i , i ) end do ! Apply Householder transformation to solution vector. if ( krank < n ) then do i = 1 , krank call dh12 ( 2 , i , krank + 1 , n , w ( i , 1 ), mdw , ws ( n1 + i - 1 ), & x , 1 , 1 , 1 ) end do endif ! Repermute variables to their input order. if ( minman > 0 ) then do i = minman , 1 , - 1 call dswap ( 1 , x ( i ), 1 , x ( ip ( i )), 1 ) end do ! Variables are now in original coordinates. ! Add solution of unconstrained problem. do i = 1 , n x ( i ) = x ( i ) + ws ( i ) end do ! Compute the residual vector norm. rnorm = sqrt ( rnorm ** 2 + xnorm ** 2 ) endif else mode = 2 endif else call dcopy ( n , ws , 1 , x , 1 ) endif ! Compute covariance matrix based on the orthogonal decomposition ! from DHFTI( ). if (. not . cov . or . krank <= 0 ) exit main krm1 = krank - 1 krp1 = krank + 1 ! Copy diagonal terms to working array. call dcopy ( krank , w , mdw + 1 , ws ( n2 ), 1 ) ! Reciprocate diagonal terms. do j = 1 , krank w ( j , j ) = 1.0_wp / w ( j , j ) end do ! Invert the upper triangular QR factor on itself. if ( krank > 1 ) then do i = 1 , krm1 do j = i + 1 , krank w ( i , j ) = - ddot ( j - i , w ( i , i ), mdw , w ( i , j ), 1 ) * w ( j , j ) end do end do endif ! Compute the inverted factor times its transpose. do i = 1 , krank do j = i , krank w ( i , j ) = ddot ( krank + 1 - j , w ( i , j ), mdw , w ( j , j ), mdw ) end do end do ! Zero out lower trapezoidal part. ! Copy upper triangular to lower triangular part. if ( krank < n ) then do j = 1 , krank call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do do i = krp1 , n call dcopy ( i , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Apply right side transformations to lower triangle. n3 = n2 + krp1 do i = 1 , krank l = n1 + i k = n2 + i rb = ws ( l - 1 ) * ws ( k - 1 ) ! If RB>=0.0_wp, transformation can be regarded as zero. if ( rb < 0.0_wp ) then rb = 1.0_wp / rb ! Store unscaled rank one Householder update in work array. call dcopy ( n , [ 0.0_wp ], 0 , ws ( n3 ), 1 ) l = n1 + i k = n3 + i ws ( k - 1 ) = ws ( l - 1 ) do j = krp1 , n ws ( n3 + j - 1 ) = w ( i , j ) end do do j = 1 , n ws ( j ) = rb * ( ddot ( j - i , w ( j , i ), mdw , ws ( n3 + i - 1 ), 1 ) + & ddot ( n - j + 1 , w ( j , j ), 1 , ws ( n3 + j - 1 ), 1 )) end do l = n3 + i gam = 0.5_wp * rb * ddot ( n - i + 1 , ws ( l - 1 ), 1 , ws ( i ), 1 ) call daxpy ( n - i + 1 , gam , ws ( l - 1 ), 1 , ws ( i ), 1 ) do j = i , n do l = 1 , i - 1 w ( j , l ) = w ( j , l ) + ws ( n3 + j - 1 ) * ws ( l ) end do do l = i , j w ( j , l ) = w ( j , l ) + ws ( j ) * ws ( n3 + l - 1 ) + ws ( l ) * ws ( n3 + j - 1 ) end do end do endif end do ! Copy lower triangle to upper triangle to symmetrize the ! covariance matrix. do i = 1 , n call dcopy ( i , w ( i , 1 ), mdw , w ( 1 , i ), 1 ) end do endif ! Repermute rows and columns. do i = minman , 1 , - 1 k = ip ( i ) if ( i /= k ) then call dswap ( 1 , w ( i , i ), 1 , w ( k , k ), 1 ) call dswap ( i - 1 , w ( 1 , i ), 1 , w ( 1 , k ), 1 ) call dswap ( k - i - 1 , w ( i , i + 1 ), mdw , w ( i + 1 , k ), 1 ) call dswap ( n - k , w ( i , k + 1 ), mdw , w ( k , k + 1 ), mdw ) endif end do ! Put in normalized residual sum of squares scale factor ! and symmetrize the resulting covariance matrix. do j = 1 , n call dscal ( j , fac , w ( 1 , j ), 1 ) call dcopy ( j , w ( 1 , j ), 1 , w ( j , 1 ), mdw ) end do end block main ip ( 1 ) = krank ip ( 2 ) = n + max ( m , n ) + ( mg + 2 ) * ( n + 7 ) end subroutine dlsi !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DWNNLS]]. ! The documentation for [[DWNNLS]] has complete usage instructions. ! ! Note: The `M` by `(N+1)` matrix `W( , )` contains the rt. hand side ! `B` as the `(N+1)`st col. ! ! Triangularize `L1` by `L1` subsystem, where `L1=MIN(M,L)`, with ! col interchanges. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and revised. (WRB & RWC) ! * 890620 Revised to make WNLT1, WNLT2, and WNLT3 subroutines. (RWC) ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900328 Added TYPE section. (WRB) ! * 900604 DP version created from SP version. . (RWC) subroutine dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , & rnorm , idope , dope , done ) integer :: idope ( * ), ipivot ( * ), itype ( * ), l , m , mdw , n real ( wp ) :: dope ( * ), h ( * ), rnorm , scale ( * ), w ( mdw , * ) logical :: done real ( wp ) :: alsq , amax , eanorm , factor , hbar , rn , sparam ( 5 ), & t , tau integer :: i , i1 , imax , ir , j , j1 , jj , jp , krank , l1 , lb , lend , me , & mend , niv , nsoln logical :: indep , recalc me = idope ( 1 ) nsoln = idope ( 2 ) l1 = idope ( 3 ) alsq = dope ( 1 ) eanorm = dope ( 2 ) tau = dope ( 3 ) lb = min ( m - 1 , l ) recalc = . true . rnorm = 0.0_wp krank = 0 ! We set FACTOR=1.0 so that the heavy weight ALAMDA will be ! included in the test for column independence. factor = 1.0_wp lend = l main : block do i = 1 , lb ! Set IR to point to the I-th row. ir = i mend = m call dwnlt1 ( i , lend , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) do ! Perform column interchange. ! Test independence of incoming column. if ( dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then ! Eliminate I-th column below diagonal using modified Givens ! transformations applied to (A B). ! ! When operating near the ME line, use the largest element ! above it as the pivot. do j = m , i + 1 , - 1 jp = j - 1 if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , i ) ** 2 do jp = j - 1 , i , - 1 t = scale ( jp ) * w ( jp , i ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( jp , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do exit else if ( lend > i ) then ! Column I is dependent. Swap with column LEND. ! Perform column interchange, ! and find column in remaining set with largest SS. call dwnlt3 ( i , lend , m , mdw , ipivot , h , w ) lend = lend - 1 imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) else krank = i - 1 exit main endif end do end do krank = l1 end block main if ( krank < me ) then factor = alsq do i = krank + 1 , me call dcopy ( l , [ 0.0_wp ], 0 , w ( i , 1 ), mdw ) end do ! Determine the rank of the remaining equality constraint ! equations by eliminating within the block of constrained ! variables. Remove any redundant constraints. recalc = . true . lb = min ( l + me - krank , n ) do i = l + 1 , lb ir = krank + i - l lend = n mend = me call dwnlt1 ( i , lend , me , ir , mdw , recalc , imax , hbar , h , & scale , w ) ! Update col ss and find pivot col call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange ! Eliminate elements in the I-th col. do j = me , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), & sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , & sparam ) endif end do ! I=column being eliminated. ! Test independence of incoming column. ! Remove any redundant or dependent equality constraints. if (. not . dwnlt2 ( me , mend , ir , factor , tau , scale , w ( 1 , i ))) then jj = ir do ir = jj , me call dcopy ( n , [ 0.0_wp ], 0 , w ( ir , 1 ), mdw ) rnorm = rnorm + ( scale ( ir ) * w ( ir , n + 1 ) / alsq ) * w ( ir , n + 1 ) w ( ir , n + 1 ) = 0.0_wp scale ( ir ) = 1.0_wp ! Reclassify the zeroed row as a least squares equation. itype ( ir ) = 1 end do ! Reduce ME to reflect any discovered dependent equality ! constraints. me = jj - 1 exit endif end do endif ! Try to determine the variables KRANK+1 through L1 from the ! least squares equations. Continue the triangularization with ! pivot element W(ME+1,I). if ( krank < l1 ) then recalc = . true . ! Set FACTOR=ALSQ to remove effect of heavy weight from ! test for column independence. factor = alsq do i = krank + 1 , l1 ! Set IR to point to the ME+1-st row. ir = me + 1 lend = l mend = m call dwnlt1 ( i , l , m , ir , mdw , recalc , imax , hbar , h , scale , w ) ! Update column SS and find pivot column. call dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) ! Perform column interchange. ! Eliminate I-th column below the IR-th element. do j = m , ir + 1 , - 1 if ( w ( j , i ) /= 0.0_wp ) then call drotmg ( scale ( j - 1 ), scale ( j ), w ( j - 1 , i ), w ( j , i ), sparam ) w ( j , i ) = 0.0_wp call drotm ( n + 1 - i , w ( j - 1 , i + 1 ), mdw , w ( j , i + 1 ), mdw , sparam ) endif end do ! Test if new pivot element is near zero. ! If so, the column is dependent. ! Then check row norm test to be classified as independent. t = scale ( ir ) * w ( ir , i ) ** 2 indep = t > ( tau * eanorm ) ** 2 if ( indep ) then rn = 0.0_wp do i1 = ir , m do j1 = i + 1 , n rn = max ( rn , scale ( i1 ) * w ( i1 , j1 ) ** 2 ) end do end do indep = t > rn * tau ** 2 endif ! If independent, swap the IR-th and KRANK+1-th rows to ! maintain the triangular form. Update the rank indicator ! KRANK and the equality constraint pointer ME. if (. not . indep ) exit call dswap ( n + 1 , w ( krank + 1 , 1 ), mdw , w ( ir , 1 ), mdw ) call dswap ( 1 , scale ( krank + 1 ), 1 , scale ( ir ), 1 ) ! Reclassify the least square equation as an equality ! constraint and rescale it. itype ( ir ) = 0 t = sqrt ( scale ( krank + 1 )) call dscal ( n + 1 , t , w ( krank + 1 , 1 ), mdw ) scale ( krank + 1 ) = alsq me = me + 1 krank = krank + 1 end do endif ! If pseudorank is less than L, apply Householder transformation. ! from right. if ( krank < l ) then do j = krank , 1 , - 1 call dh12 ( 1 , j , krank + 1 , l , w ( j , 1 ), mdw , h ( j ), w , mdw , 1 , & j - 1 ) end do endif niv = krank + nsoln - l if ( l == n ) done = . true . ! End of initial triangularization. idope ( 1 ) = me idope ( 2 ) = krank idope ( 3 ) = niv end subroutine dwnlit !***************************************************************************************** !***************************************************************************************** !> ! This is a companion subprogram to [[DWNNLS]]. ! The documentation for [[DWNNLS]] has complete usage instructions. ! ! In addition to the parameters discussed in the prologue to ! subroutine [[DWNNLS]], the following work arrays are used in ! subroutine [[DWNLSM]] (they are passed through the calling ! sequence from [[DWNNLS]] for purposes of variable dimensioning). ! Their contents will in general be of no interest to the user. ! ! IPIVOT(*) ! An array of length N. Upon completion it contains the ! pivoting information for the cols of W(*,*). ! ! ITYPE(*) ! An array of length M which is used to keep track ! of the classification of the equations. ITYPE(I)=0 ! denotes equation I as an equality constraint. ! ITYPE(I)=1 denotes equation I as a least squares ! equation. ! ! WD(*) ! An array of length N. Upon completion it contains the ! dual solution vector. ! ! H(*) ! An array of length N. Upon completion it contains the ! pivot scalars of the Householder transformations performed ! in the case KRANK nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif do if ( link <= 1 ) exit ntimes = ntimes + 1 if ( ntimes > nopt ) then write ( * , * ) 'IN DWNNLS, THE LINKS IN THE OPTION VECTOR ARE CYCLING.' return endif key = prgopt ( last + 1 ) if ( key == 6 . and . prgopt ( last + 2 ) /= 0.0_wp ) then do j = 1 , n t = dnrm2 ( m , w ( 1 , j ), 1 ) if ( t /= 0.0_wp ) t = 1.0_wp / t d ( j ) = t end do endif if ( key == 7 ) call dcopy ( n , prgopt ( last + 2 ), 1 , d , 1 ) if ( key == 8 ) tau = max ( drelpr , prgopt ( last + 2 )) if ( key == 9 ) blowup = max ( drelpr , prgopt ( last + 2 )) next = prgopt ( link ) if ( next <= 0 . or . next > nlink ) then write ( * , * ) 'IN DWNNLS, THE OPTION VECTOR IS UNDEFINED' return endif last = link link = next end do do j = 1 , n call dscal ( m , d ( j ), w ( 1 , j ), 1 ) end do ! Process option vector done = . false . iter = 0 itmax = 3 * ( n - l ) mode = 0 nsoln = l l1 = min ( m , l ) ! Compute scale factor to apply to equality constraint equations. do j = 1 , n wd ( j ) = dasum ( m , w ( 1 , j ), 1 ) end do imax = idamax ( n , wd , 1 ) eanorm = wd ( imax ) bnorm = dasum ( m , w ( 1 , n + 1 ), 1 ) alamda = eanorm / ( drelpr * fac ) ! On machines, such as the VAXes using D floating, with a very ! limited exponent range for double precision values, the previously ! computed value of ALAMDA may cause an overflow condition. ! Therefore, this code further limits the value of ALAMDA. alamda = min ( alamda , sqrt ( huge ( 1.0_wp ))) ! Define scaling diagonal matrix for modified Givens usage and ! classify equation types. alsq = alamda ** 2 do i = 1 , m ! When equation I is heavily weighted ITYPE(I)=0, ! else ITYPE(I)=1. if ( i <= me ) then t = alsq itemp = 0 else t = 1.0_wp itemp = 1 endif scale ( i ) = t itype ( i ) = itemp end do ! Set the solution vector X(*) to zero and the column interchange ! matrix to the identity. call dcopy ( n , [ 0.0_wp ], 0 , x , 1 ) do i = 1 , n ipivot ( i ) = i end do ! Perform initial triangularization in the submatrix ! corresponding to the unconstrained variables. ! Set first L components of dual vector to zero because ! these correspond to the unconstrained variables. call dcopy ( l , [ 0.0_wp ], 0 , wd , 1 ) ! The arrays IDOPE(*) and DOPE(*) are used to pass ! information to DWNLIT(). This was done to avoid ! a long calling sequence or the use of COMMON. idope ( 1 ) = me idope ( 2 ) = nsoln idope ( 3 ) = l1 dope ( 1 ) = alsq dope ( 2 ) = eanorm dope ( 3 ) = tau call dwnlit ( w , mdw , m , n , l , ipivot , itype , h , scale , rnorm , & idope , dope , done ) me = idope ( 1 ) krank = idope ( 2 ) niv = idope ( 3 ) main : do ! Perform WNNLS algorithm using the following steps. ! ! Until(DONE) ! compute search direction and feasible point ! when (HITCON) add constraints ! else perform multiplier test and drop a constraint ! fin ! Compute-Final-Solution ! ! To compute search direction and feasible point, ! solve the triangular system of currently non-active ! variables and store the solution in Z(*). ! ! To solve system ! Copy right hand side into TEMP vector to use overwriting method. if ( done ) exit main isol = l + 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Increment iteration counter and check against maximum number ! of iterations. iter = iter + 1 if ( iter > itmax ) then mode = 1 done = . true . endif ! Check to see if any constraints have become active. ! If so, calculate an interpolation factor so that all ! active constraints are removed from the basis. alpha = 2.0_wp hitcon = . false . do j = l + 1 , nsoln zz = z ( j ) if ( zz <= 0.0_wp ) then t = x ( j ) / ( x ( j ) - zz ) if ( t < alpha ) then alpha = t jcon = j endif hitcon = . true . endif end do ! Compute search direction and feasible point if ( hitcon ) then ! To add constraints, use computed ALPHA to interpolate between ! last feasible solution X(*) and current unconstrained (and ! infeasible) solution Z(*). do j = l + 1 , nsoln x ( j ) = x ( j ) + alpha * ( z ( j ) - x ( j )) end do feasbl = . false . do ! Remove column JCON and shift columns JCON+1 through N to the ! left. Swap column JCON into the N th position. This achieves ! upper Hessenberg form for the nonactive constraints and ! leaves an upper Hessenberg matrix to retriangularize. do i = 1 , m t = w ( i , jcon ) call dcopy ( n - jcon , w ( i , jcon + 1 ), mdw , w ( i , jcon ), mdw ) w ( i , n ) = t end do ! Update permuted index vector to reflect this shift and swap. itemp = ipivot ( jcon ) do i = jcon , n - 1 ipivot ( i ) = ipivot ( i + 1 ) end do ipivot ( n ) = itemp ! Similarly permute X(*) vector. call dcopy ( n - jcon , x ( jcon + 1 ), 1 , x ( jcon ), 1 ) x ( n ) = 0.0_wp nsoln = nsoln - 1 niv = niv - 1 ! Retriangularize upper Hessenberg matrix after adding ! constraints. i = krank + jcon - l do j = jcon , nsoln if ( itype ( i ) == 0 . and . itype ( i + 1 ) == 0 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 1 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 1 . and . itype ( i + 1 ) == 0 ) then call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp ! Swapped row was formerly a pivot element, so it will ! be large enough to perform elimination. ! Zero IP1 to I in column J. if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), w ( i + 1 , j ), & sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif elseif ( itype ( i ) == 0 . and . itype ( i + 1 ) == 1 ) then if ( scale ( i ) * w ( i , j ) ** 2 / alsq > ( tau * eanorm ) ** 2 ) then ! Zero IP1 to I in column J if ( w ( i + 1 , j ) /= 0.0_wp ) then call drotmg ( scale ( i ), scale ( i + 1 ), w ( i , j ), & w ( i + 1 , j ), sparam ) w ( i + 1 , j ) = 0.0_wp call drotm ( n + 1 - j , w ( i , j + 1 ), mdw , w ( i + 1 , j + 1 ), mdw , & sparam ) endif else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( i + 1 , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( i + 1 ), 1 ) itemp = itype ( i + 1 ) itype ( i + 1 ) = itype ( i ) itype ( i ) = itemp w ( i + 1 , j ) = 0.0_wp endif endif i = i + 1 end do ! See if the remaining coefficients in the solution set are ! feasible. They should be because of the way ALPHA was ! determined. If any are infeasible, it is due to roundoff ! error. Any that are non-positive will be set to zero and ! removed from the solution set. do jcon = l + 1 , nsoln if ( x ( jcon ) <= 0.0_wp ) then exit else if ( jcon == nsoln ) feasbl = . true . end if end do if ( feasbl ) exit end do else ! To perform multiplier test and drop a constraint. call dcopy ( nsoln , z , 1 , x , 1 ) if ( nsoln < n ) call dcopy ( n - nsoln , [ 0.0_wp ], 0 , x ( nsoln + 1 ), 1 ) ! Reclassify least squares equations as equalities as necessary. i = niv + 1 do if ( i > me ) exit if ( itype ( i ) == 0 ) then i = i + 1 else call dswap ( n + 1 , w ( i , 1 ), mdw , w ( me , 1 ), mdw ) call dswap ( 1 , scale ( i ), 1 , scale ( me ), 1 ) itemp = itype ( i ) itype ( i ) = itype ( me ) itype ( me ) = itemp me = me - 1 endif end do ! Form inner product vector WD(*) of dual coefficients. do j = nsoln + 1 , n sm = 0.0_wp do i = nsoln + 1 , m sm = sm + scale ( i ) * w ( i , j ) * w ( i , n + 1 ) end do wd ( j ) = sm end do do ! Find J such that WD(J)=WMAX is maximum. This determines ! that the incoming column J will reduce the residual vector ! and be positive. wmax = 0.0_wp iwmax = nsoln + 1 do j = nsoln + 1 , n if ( wd ( j ) > wmax ) then wmax = wd ( j ) iwmax = j endif end do if ( wmax <= 0.0_wp ) exit main ! Set dual coefficients to zero for incoming column. wd ( iwmax ) = 0.0_wp ! WMAX > 0.0_wp, so okay to move column IWMAX to solution set. ! Perform transformation to retriangularize, and test for near ! linear dependence. ! ! Swap column IWMAX into NSOLN-th position to maintain upper ! Hessenberg form of adjacent columns, and add new column to ! triangular decomposition. nsoln = nsoln + 1 niv = niv + 1 if ( nsoln /= iwmax ) then call dswap ( m , w ( 1 , nsoln ), 1 , w ( 1 , iwmax ), 1 ) wd ( iwmax ) = wd ( nsoln ) wd ( nsoln ) = 0.0_wp itemp = ipivot ( nsoln ) ipivot ( nsoln ) = ipivot ( iwmax ) ipivot ( iwmax ) = itemp endif ! Reduce column NSOLN so that the matrix of nonactive constraints ! variables is triangular. do j = m , niv + 1 , - 1 jp = j - 1 ! When operating near the ME line, test to see if the pivot ! element is near zero. If so, use the largest element above ! it as the pivot. This is to maintain the sharp interface ! between weighted and non-weighted rows in all cases. if ( j == me + 1 ) then imax = me amax = scale ( me ) * w ( me , nsoln ) ** 2 do jp = j - 1 , niv , - 1 t = scale ( jp ) * w ( jp , nsoln ) ** 2 if ( t > amax ) then imax = jp amax = t endif end do jp = imax endif if ( w ( j , nsoln ) /= 0.0_wp ) then call drotmg ( scale ( jp ), scale ( j ), w ( jp , nsoln ), w ( j , nsoln ), sparam ) w ( j , nsoln ) = 0.0_wp call drotm ( n + 1 - nsoln , w ( jp , nsoln + 1 ), mdw , w ( j , nsoln + 1 ), mdw , sparam ) endif end do ! Solve for Z(NSOLN)=proposed new value for X(NSOLN). Test if ! this is nonpositive or too large. If this was true or if the ! pivot term was zero, reject the column as dependent. if ( w ( niv , nsoln ) /= 0.0_wp ) then isol = niv z2 = w ( isol , n + 1 ) / w ( isol , nsoln ) z ( nsoln ) = z2 pos = z2 > 0.0_wp if ( z2 * eanorm >= bnorm . and . pos ) then pos = . not . ( blowup * z2 * eanorm >= bnorm ) endif elseif ( niv <= me . and . w ( me + 1 , nsoln ) /= 0.0_wp ) then ! Try to add row ME+1 as an additional equality constraint. ! Check size of proposed new solution component. ! Reject it if it is too large. isol = me + 1 if ( pos ) then ! Swap rows ME+1 and NIV, and scale factors for these rows. call dswap ( n + 1 , w ( me + 1 , 1 ), mdw , w ( niv , 1 ), mdw ) call dswap ( 1 , scale ( me + 1 ), 1 , scale ( niv ), 1 ) itemp = itype ( me + 1 ) itype ( me + 1 ) = itype ( niv ) itype ( niv ) = itemp me = me + 1 endif else pos = . false . endif if (. not . pos ) then nsoln = nsoln - 1 niv = niv - 1 endif if ( pos . or . done ) exit end do endif end do main ! Else perform multiplier test and drop a constraint. To compute ! final solution. Solve system, store results in X(*). ! ! Copy right hand side into TEMP vector to use overwriting method. isol = 1 if ( nsoln >= isol ) then call dcopy ( niv , w ( 1 , n + 1 ), 1 , temp , 1 ) do j = nsoln , isol , - 1 if ( j > krank ) then i = niv - nsoln + j else i = j endif if ( j > krank . and . j <= l ) then z ( j ) = 0.0_wp else z ( j ) = temp ( i ) / w ( i , j ) call daxpy ( i - 1 , - z ( j ), w ( 1 , j ), 1 , temp , 1 ) endif end do endif ! Solve system. call dcopy ( nsoln , z , 1 , x , 1 ) ! Apply Householder transformations to X(*) if KRANK ! To update the column Sum Of Squares and find the pivot column. ! The column Sum of Squares Vector will be updated at each step. ! When numerically necessary, these values will be recomputed. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890620 Code extracted from WNLIT and made a subroutine. (RWC)) ! * 900604 DP version created from SP version. (RWC) subroutine dwnlt1 ( i , lend , mend , ir , mdw , recalc , imax , hbar , h , & scale , w ) integer :: i , imax , ir , lend , mdw , mend real ( wp ) :: h ( * ), hbar , scale ( * ), w ( mdw , * ) logical :: recalc integer :: j , k if ( ir /= 1 . and . (. not . recalc )) then ! Update column SS=sum of squares. do j = i , lend h ( j ) = h ( j ) - scale ( ir - 1 ) * w ( ir - 1 , j ) ** 2 end do ! Test for numerical accuracy. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 recalc = ( hbar + 1.e-3 * h ( imax )) == hbar endif ! If required, recalculate column SS, using rows IR through MEND. if ( recalc ) then do j = i , lend h ( j ) = 0.0_wp do k = ir , mend h ( j ) = h ( j ) + scale ( k ) * w ( k , j ) ** 2 end do end do ! Find column with largest SS. imax = idamax ( lend - i + 1 , h ( i ), 1 ) + i - 1 hbar = h ( imax ) endif end subroutine dwnlt1 !***************************************************************************************** !***************************************************************************************** !> ! To test independence of incoming column. ! ! Test the column IC to determine if it is linearly independent ! of the columns already in the basis. In the initial tri. step, ! we usually want the heavy weight ALAMDA to be included in the ! test for independence. In this case, the value of `FACTOR` will ! have been set to 1.0 before this procedure is invoked. ! In the potentially rank deficient problem, the value of FACTOR ! will have been set to `ALSQ=ALAMDA**2` to remove the effect of the ! heavy weight from the test for independence. ! ! Write new column as partitioned vector ! ! * `(A1)` number of components in solution so far `= NIV` ! * `(A2)` `M-NIV` components ! ! And compute ! ! * `SN` = inverse weighted length of `A1` ! * `RN` = inverse weighted length of `A2` ! ! Call the column independent when `RN > TAU*SN` ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890620 Code extracted from WNLIT and made a subroutine. (RWC)) ! * 900604 DP version created from SP version. (RWC) logical function dwnlt2 ( me , mend , ir , factor , tau , scale , wic ) real ( wp ) :: factor , scale ( * ), tau , wic ( * ) integer :: ir , me , mend real ( wp ) :: rn , sn , t integer :: j sn = 0.0_wp rn = 0.0_wp do j = 1 , mend t = scale ( j ) if ( j <= me ) t = t / factor t = t * wic ( j ) ** 2 if ( j < ir ) then sn = sn + t else rn = rn + t endif end do dwnlt2 = rn > sn * tau ** 2 end function dwnlt2 !***************************************************************************************** !***************************************************************************************** !> ! Perform column interchange. ! Exchange elements of permuted index vector and perform column ! interchanges. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890620 Code extracted from WNLIT and made a subroutine. (RWC)) ! * 900604 DP version created from SP version. (RWC) subroutine dwnlt3 ( i , imax , m , mdw , ipivot , h , w ) integer , intent ( in ) :: i integer , intent ( in ) :: imax integer , intent ( inout ) :: ipivot ( * ) integer , intent ( in ) :: m integer , intent ( in ) :: mdw real ( wp ), intent ( inout ) :: h ( * ) real ( wp ), intent ( inout ) :: w ( mdw , * ) real ( wp ) :: t integer :: itemp if ( imax /= i ) then itemp = ipivot ( i ) ipivot ( i ) = ipivot ( imax ) ipivot ( imax ) = itemp call dswap ( m , w ( 1 , imax ), 1 , w ( 1 , i ), 1 ) t = h ( imax ) h ( imax ) = h ( i ) h ( i ) = t endif end subroutine dwnlt3 !***************************************************************************************** !***************************************************************************************** !> ! This subprogram solves a linearly constrained least squares ! problem. Suppose there are given matrices `E` and `A` of ! respective dimensions `ME` by `N` and `MA` by `N`, and vectors `F` ! and `B` of respective lengths `ME` and `MA`. This subroutine ! solves the problem ! ! * `EX = F`, (equations to be exactly satisfied) ! * `AX = B`, (equations to be approximately satisfied, in the least squares sense) ! ! subject to components `L+1,...,N` nonnegative ! ! Any values `ME>=0`, `MA>=0` and `0<= L <=N` are permitted. ! ! The problem is reposed as problem [[DWNNLS]] ! !``` ! (WT*E)X = (WT*F) ! ( A) ( B), (least squares) ! subject to components L+1,...,N nonnegative. !``` ! ! The subprogram chooses the heavy weight (or penalty parameter) `WT`. ! ! The parameters for [[DWNNLS]] are ! !``` ! INPUT.. All TYPE REAL variables are DOUBLE PRECISION ! ! W(*,*),MDW, The array W(*,*) is double subscripted with first ! ME,MA,N,L dimensioning parameter equal to MDW. For this ! discussion let us call M = ME + MA. Then MDW ! must satisfy MDW>=M. The condition MDWN is ! an error. ! ! PRGOPT(*) This double precision array is the option vector. ! If the user is satisfied with the nominal ! subprogram features set ! ! PRGOPT(1)=1 (or PRGOPT(1)=1.0) ! ! Otherwise PRGOPT(*) is a linked list consisting of ! groups of data of the following form ! ! LINK ! KEY ! DATA SET ! ! The parameters LINK and KEY are each one word. ! The DATA SET can be comprised of several words. ! The number of items depends on the value of KEY. ! The value of LINK points to the first ! entry of the next group of data within ! PRGOPT(*). The exception is when there are ! no more options to change. In that ! case LINK=1 and the values KEY and DATA SET ! are not referenced. The general layout of ! PRGOPT(*) is as follows. ! ! ...PRGOPT(1)=LINK1 (link to first entry of next group) ! . PRGOPT(2)=KEY1 (key to the option change) ! . PRGOPT(3)=DATA VALUE (data value for this change) ! . . ! . . ! . . ! ...PRGOPT(LINK1)=LINK2 (link to the first entry of ! . next group) ! . PRGOPT(LINK1+1)=KEY2 (key to the option change) ! . PRGOPT(LINK1+2)=DATA VALUE ! ... . ! . . ! . . ! ...PRGOPT(LINK)=1 (no more options to change) ! ! Values of LINK that are nonpositive are errors. ! A value of LINK>NLINK=100000 is also an error. ! This helps prevent using invalid but positive ! values of LINK that will probably extend ! beyond the program limits of PRGOPT(*). ! Unrecognized values of KEY are ignored. The ! order of the options is arbitrary and any number ! of options can be changed with the following ! restriction. To prevent cycling in the ! processing of the option array a count of the ! number of options changed is maintained. ! Whenever this count exceeds NOPT=1000 an error ! message is printed and the subprogram returns. ! ! OPTIONS.. ! ! KEY=6 ! Scale the nonzero columns of the ! entire data matrix ! (E) ! (A) ! to have length one. The DATA SET for ! this option is a single value. It must ! be nonzero if unit length column scaling is ! desired. ! ! KEY=7 ! Scale columns of the entire data matrix ! (E) ! (A) ! with a user-provided diagonal matrix. ! The DATA SET for this option consists ! of the N diagonal scaling factors, one for ! each matrix column. ! ! KEY=8 ! Change the rank determination tolerance from ! the nominal value of SQRT(SRELPR). This quantity ! can be no smaller than SRELPR, The arithmetic- ! storage precision. The quantity used ! here is internally restricted to be at ! least SRELPR. The DATA SET for this option ! is the new tolerance. ! ! KEY=9 ! Change the blow-up parameter from the ! nominal value of SQRT(SRELPR). The reciprocal of ! this parameter is used in rejecting solution ! components as too large when a variable is ! first brought into the active set. Too large ! means that the proposed component times the ! reciprocal of the parameter is not less than ! the ratio of the norms of the right-side ! vector and the data matrix. ! This parameter can be no smaller than SRELPR, ! the arithmetic-storage precision. ! ! For example, suppose we want to provide ! a diagonal matrix to scale the problem ! matrix and change the tolerance used for ! determining linear dependence of dropped col ! vectors. For these options the dimensions of ! PRGOPT(*) must be at least N+6. The FORTRAN ! statements defining these options would ! be as follows. ! ! PRGOPT(1)=N+3 (link to entry N+3 in PRGOPT(*)) ! PRGOPT(2)=7 (user-provided scaling key) ! ! CALL DCOPY(N,D,1,PRGOPT(3),1) (copy the N ! scaling factors from a user array called D(*) ! into PRGOPT(3)-PRGOPT(N+2)) ! ! PRGOPT(N+3)=N+6 (link to entry N+6 of PRGOPT(*)) ! PRGOPT(N+4)=8 (linear dependence tolerance key) ! PRGOPT(N+5)=... (new value of the tolerance) ! ! PRGOPT(N+6)=1 (no more options to change) ! ! ! IWORK(1), The amounts of working storage actually allocated ! IWORK(2) for the working arrays WORK(*) and IWORK(*), ! respectively. These quantities are compared with ! the actual amounts of storage needed for DWNNLS( ). ! Insufficient storage allocated for either WORK(*) ! or IWORK(*) is considered an error. This feature ! was included in DWNNLS( ) because miscalculating ! the storage formulas for WORK(*) and IWORK(*) ! might very well lead to subtle and hard-to-find ! execution errors. ! ! The length of WORK(*) must be at least ! ! LW = ME+MA+5*N ! This test will not be made if IWORK(1)<=0. ! ! The length of IWORK(*) must be at least ! ! LIW = ME+MA+N ! This test will not be made if IWORK(2)<=0. ! ! OUTPUT.. All TYPE REAL variables are DOUBLE PRECISION ! ! X(*) An array dimensioned at least N, which will ! contain the N components of the solution vector ! on output. ! ! RNORM The residual norm of the solution. The value of ! RNORM contains the residual vector length of the ! equality constraints and least squares equations. ! ! MODE The value of MODE indicates the success or failure ! of the subprogram. ! ! MODE = 0 Subprogram completed successfully. ! ! = 1 Max. number of iterations (equal to ! 3*(N-L)) exceeded. Nearly all problems ! should complete in fewer than this ! number of iterations. An approximate ! solution and its corresponding residual ! vector length are in X(*) and RNORM. ! ! = 2 Usage error occurred. The offending ! condition is noted with the error ! processing subprogram, XERMSG( ). ! ! User-designated ! Working arrays.. ! ! WORK(*) A double precision working array of length at least ! M + 5*N. ! ! IWORK(*) An integer-valued working array of length at least ! M+N. !``` ! !### References ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Report SAND77-0552, Sandia ! Laboratories, June 1978. ! * K. H. Haskell and R. J. Hanson, Selected algorithms for ! the linearly constrained least squares problem - a ! users guide, Report SAND78-1290, Sandia Laboratories, ! August 1979. ! * K. H. Haskell and R. J. Hanson, An algorithm for ! linear least squares problems with equality and ! nonnegativity constraints, Mathematical Programming ! 21 (1981), pp. 98-118. ! * R. J. Hanson and K. H. Haskell, Two algorithms for the ! linearly constrained least squares problem, ACM ! Transactions on Mathematical Software, September 1982. ! * C. L. Lawson and R. J. Hanson, Solving Least Squares ! Problems, Prentice-Hall, Inc., 1974. ! !### Revision history ! * 790701 DATE WRITTEN. Hanson, R. J., (SNLA), Haskell, K. H., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890618 Completely restructured and revised. (WRB & RWC) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) ! * 900510 Convert XERRWV calls to XERMSG calls, change Prologue ! comments to agree with WNNLS. (RWC) ! * 920501 Reformatted the REFERENCES section. (WRB) subroutine dwnnls ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , & iwork , work ) integer :: iwork ( * ), l , l1 , l2 , l3 , l4 , l5 , liw , lw , ma , mdw , me , & mode , n real ( wp ) :: prgopt ( * ), rnorm , w ( mdw , * ), work ( * ), x ( * ) character ( len = 8 ) :: xern1 mode = 0 if ( ma + me <= 0 . or . n <= 0 ) return if ( iwork ( 1 ) > 0 ) then lw = me + ma + 5 * n if ( iwork ( 1 ) < lw ) then write ( xern1 , '(I8)' ) lw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR WORK(*), NEED LW = ' // xern1 mode = 2 return endif endif if ( iwork ( 2 ) > 0 ) then liw = me + ma + n if ( iwork ( 2 ) < liw ) then write ( xern1 , '(I8)' ) liw write ( * , * ) 'INSUFFICIENT STORAGE ' // & 'ALLOCATED FOR IWORK(*), NEED LIW = ' // xern1 mode = 2 return endif endif if ( mdw < me + ma ) then write ( * , * ) 'THE VALUE MDW n ) then write ( * , * ) 'L>=0 .AND. L<=N IS REQUIRED' mode = 2 return endif ! THE PURPOSE OF THIS SUBROUTINE IS TO BREAK UP THE ARRAYS ! WORK(*) AND IWORK(*) INTO SEPARATE WORK ARRAYS ! REQUIRED BY THE MAIN SUBROUTINE DWNLSM( ). l1 = n + 1 l2 = l1 + n l3 = l2 + me + ma l4 = l3 + n l5 = l4 + n call dwnlsm ( w , mdw , me , ma , n , l , prgopt , x , rnorm , mode , iwork , & iwork ( l1 ), work ( 1 ), work ( l1 ), work ( l2 ), work ( l3 ), & work ( l4 ), work ( l5 )) end subroutine dwnnls !***************************************************************************************** !***************************************************************************************** !> ! [[dcv]] is a companion function subprogram for [[dfc]]. The ! documentation for [[dfc]] has complete usage instructions. ! ! [[dcv]] is used to evaluate the variance function of the curve ! obtained by the constrained B-spline fitting subprogram, [[dfc]]. ! The variance function defines the square of the probable error ! of the fitted curve at any point, XVAL. One can use the square ! root of this variance function to determine a probable error band ! around the fitted curve. ! ! [[dcv]] is used after a call to [[dfc]]. MODE, an input variable to ! [[dfc]], is used to indicate if the variance function is desired. ! In order to use [[dcv]], MODE must equal 2 or 4 on input to [[dfc]]. ! MODE is also used as an output flag from [[dfc]]. Check to make ! sure that MODE = 0 after calling [[dfc]], indicating a successful ! constrained curve fit. The array SDDATA, as input to [[dfc]], must ! also be defined with the standard deviation or uncertainty of the ! Y values to use [[dcv]]. ! ! To evaluate the variance function after calling [[dfc]] as stated ! above, use [[dcv]] as shown here ! ! `VAR = DCV(XVAL,NDATA,NCONST,NORD,NBKPT,BKPT,W)` ! ! The variance function is given by ! ! `VAR = (transpose of B(XVAL))*C*B(XVAL)/DBLE(MAX(NDATA-N,1))` ! ! where `N = NBKPT - NORD`. ! ! The vector B(XVAL) is the B-spline basis function values at ! X=XVAL. The covariance matrix, C, of the solution coefficients ! accounts only for the least squares equations and the explicitly ! stated equality constraints. This fact must be considered when ! interpreting the variance function from a data fitting problem ! that has inequality constraints on the fitted curve. ! ! All the variables in the calling sequence for [[dcv]] are used in ! [[dfc]] except the variable XVAL. Do not change the values of ! these variables between the call to [[dfc]] and the use of [[dcv]]. ! !### Reference ! * R. J. Hanson, Constrained least squares curve fitting ! to discrete data using B-splines, a users guide, ! Report SAND78-1291, Sandia Laboratories, December ! 1978. ! !### Revision history ! * 780801 DATE WRITTEN. Hanson, R. J., (SNLA) ! * 890531 Changed all specific intrinsics to generic. (WRB) ! * 890831 Modified array declarations. (WRB) ! * 890911 Removed unnecessary intrinsics. (WRB) ! * 891006 Cosmetic changes to prologue. (WRB) ! * 891006 REVISION DATE from Version 3.2 ! * 891214 Prologue converted to Version 4.0 format. (BAB) ! * 920501 Reformatted the REFERENCES section. (WRB) real ( wp ) function dcv ( xval , ndata , nconst , nord , nbkpt , bkpt , w ) real ( wp ), intent ( in ) :: xval !! The point where the variance is desired integer , intent ( in ) :: nbkpt !! The number of knots in the array BKPT(*). !! The value of NBKPT must satisfy NBKPT .GE. 2*NORD. integer , intent ( in ) :: nconst !! The number of conditions that constrained the B-spline in !! [[dfc]]. integer , intent ( in ) :: ndata !! The number of discrete (X,Y) pairs for which [[dfc]] !! calculated a piece-wise polynomial curve. integer , intent ( in ) :: nord !! The order of the B-spline used in [[dfc]]. !! The value of NORD must satisfy 1 < NORD < 20 . !! !! (The order of the spline is one more than the degree of !! the piece-wise polynomial defined on each interval. This !! is consistent with the B-spline package convention. For !! example, NORD=4 when we are using piece-wise cubics.) real ( wp ), intent ( in ) :: bkpt ( * ) !! The array of knots. Normally the problem !! data interval will be included between the limits !! BKPT(NORD) and BKPT(NBKPT-NORD+1). The additional end !! knots BKPT(I),I=1,...,NORD-1 and I=NBKPT-NORD+2,...,NBKPT, !! are required by [[dfc]] to compute the functions used to !! fit the data. real ( wp ) :: w ( * ) !! Real work array as used in [[dfc]]. See [[dfc]] !! for the required length of W(*). The contents of W(*) !! must not be modified by the user if the variance function !! is desired. real ( wp ) :: v ( 40 ) integer :: i , ileft , ip , is , last , mdg , mdw , n integer :: dfspvn_j real ( wp ), dimension ( 20 ) :: dfspvn_deltam , dfspvn_deltap real ( wp ), parameter :: zero = 0.0_wp ! set up variables for dfspvn dfspvn_j = 1 dfspvn_deltam = zero dfspvn_deltap = zero mdg = nbkpt - nord + 3 mdw = nbkpt - nord + 1 + nconst is = mdg * ( nord + 1 ) + 2 * max ( ndata , nbkpt ) + nbkpt + nord ** 2 last = nbkpt - nord + 1 ileft = nord do if ( xval < bkpt ( ileft + 1 ) . or . ileft >= last - 1 ) exit ileft = ileft + 1 end do call dfspvn ( bkpt , nord , 1 , xval , ileft , v ( nord + 1 ), & dfspvn_j , dfspvn_deltam , dfspvn_deltap ) ileft = ileft - nord + 1 ip = mdw * ( ileft - 1 ) + ileft + is n = nbkpt - nord do i = 1 , nord v ( i ) = ddot ( nord , w ( ip ), 1 , v ( nord + 1 ), 1 ) ip = ip + mdw end do dcv = max ( ddot ( nord , v , 1 , v ( nord + 1 ), 1 ), zero ) ! scale the variance so it is an unbiased estimate. dcv = dcv / max ( ndata - n , 1 ) end function dcv !***************************************************************************************** !***************************************************************************************** end module bspline_defc_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_defc_module.f90.html"},{"title":"bspline_module.f90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_module.f90~~EfferentGraph sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_blas_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! !### Description ! ! Multidimensional (1D-6D) B-Spline interpolation of data on a regular grid. ! This module uses both the subroutine and object-oriented modules. module bspline_module use bspline_kinds_module , only : bspline_wp => wp use bspline_oo_module use bspline_sub_module use bspline_defc_module implicit none public !***************************************************************************************** end module bspline_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_module.f90.html"},{"title":"bspline_kinds_module.F90 – bspline-fortran","text":"Files dependent on this one sourcefile~~bspline_kinds_module.f90~~AfferentGraph sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_blas_module.f90 bspline_blas_module.F90 sourcefile~bspline_blas_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_defc_module.f90 bspline_defc_module.F90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_defc_module.f90->sourcefile~bspline_blas_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_defc_module.f90 sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! !### Description ! Numeric kind definitions for BSpline-Fortran. module bspline_kinds_module use , intrinsic :: iso_fortran_env implicit none private #ifdef REAL32 integer , parameter , public :: wp = real32 !! Real working precision [4 bytes] #elif REAL64 integer , parameter , public :: wp = real64 !! Real working precision [8 bytes] #elif REAL128 integer , parameter , public :: wp = real128 !! Real working precision [16 bytes] #else integer , parameter , public :: wp = real64 !! Real working precision if not specified [8 bytes] #endif #ifdef INT8 integer , parameter , public :: ip = int8 !! Integer working precision [1 byte] #elif INT16 integer , parameter , public :: ip = int16 !! Integer working precision [2 bytes] #elif INT32 integer , parameter , public :: ip = int32 !! Integer working precision [4 bytes] #elif INT64 integer , parameter , public :: ip = int64 !! Integer working precision [8 bytes] #else integer , parameter , public :: ip = int32 !! Integer working precision if not specified [4 bytes] #endif !***************************************************************************************** end module bspline_kinds_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_kinds_module.f90.html"},{"title":"bspline_oo_module.f90 – bspline-fortran","text":"This file depends on sourcefile~~bspline_oo_module.f90~~EfferentGraph sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_kinds_module.f90 bspline_kinds_module.F90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_kinds_module.f90 sourcefile~bspline_sub_module.f90 bspline_sub_module.f90 sourcefile~bspline_oo_module.f90->sourcefile~bspline_sub_module.f90 sourcefile~bspline_sub_module.f90->sourcefile~bspline_kinds_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Files dependent on this one sourcefile~~bspline_oo_module.f90~~AfferentGraph sourcefile~bspline_oo_module.f90 bspline_oo_module.f90 sourcefile~bspline_module.f90 bspline_module.f90 sourcefile~bspline_module.f90->sourcefile~bspline_oo_module.f90 Help Graph Key Nodes of different colours represent the following: Graph Key Source File Source File This Page's Entity This Page's Entity Solid arrows point from a file to a file which it depends on. A file\nis dependent upon another if the latter must be compiled before the former\ncan be. Source Code !***************************************************************************************** !> author: Jacob Williams ! license: BSD ! date: 12/6/2015 ! ! Object-oriented style wrappers to [[bspline_sub_module]]. ! This module provides classes ([[bspline_1d(type)]], [[bspline_2d(type)]], ! [[bspline_3d(type)]], [[bspline_4d(type)]], [[bspline_5d(type)]], and [[bspline_6d(type)]]) ! which can be used instead of the main subroutine interface. module bspline_oo_module use bspline_kinds_module , only : wp , ip use , intrinsic :: iso_fortran_env , only : error_unit use bspline_sub_module implicit none private integer ( ip ), parameter :: int_size = storage_size ( 1_ip , kind = ip ) !! size of a default integer [bits] integer ( ip ), parameter :: logical_size = storage_size (. true ., kind = ip ) !! size of a default logical [bits] integer ( ip ), parameter :: real_size = storage_size ( 1.0_wp , kind = ip ) !! size of a `real(wp)` [bits] type , public , abstract :: bspline_class !! Base class for the b-spline types private integer ( ip ) :: inbvx = 1_ip !! internal variable used by [[dbvalu]] for efficient processing integer ( ip ) :: iflag = 1_ip !! saved `iflag` from the list routine call. logical :: initialized = . false . !! true if the class is initialized and ready to use logical :: extrap = . false . !! if true, then extrapolation is allowed during evaluation contains private procedure , non_overridable :: destroy_base !! destructor for the abstract type procedure , non_overridable :: set_extrap_flag !! internal routine to set the `extrap` flag procedure ( destroy_func ), deferred , public :: destroy !! destructor procedure ( size_func ), deferred , public :: size_of !! size of the structure in bits procedure , public , non_overridable :: status_ok !! returns true if the last `iflag` status code was `=0`. procedure , public , non_overridable :: status_message => get_bspline_status_message !! retrieve the last !! status message procedure , public , non_overridable :: clear_flag => clear_bspline_flag !! to reset the `iflag` saved in the class. end type bspline_class abstract interface pure subroutine destroy_func ( me ) !! interface for bspline destructor routines import :: bspline_class implicit none class ( bspline_class ), intent ( inout ) :: me end subroutine destroy_func pure function size_func ( me ) result ( s ) !! interface for size routines import :: bspline_class , ip implicit none class ( bspline_class ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits end function size_func end interface type , extends ( bspline_class ), public :: bspline_1d !! Class for 1d b-spline interpolation. !! !!@note The 1D class also contains two methods !! for computing definite integrals. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x real ( wp ), dimension (:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db1val] work array of dimension `3*kx` contains private generic , public :: initialize => initialize_1d_auto_knots , initialize_1d_specify_knots procedure :: initialize_1d_auto_knots procedure :: initialize_1d_specify_knots procedure , public :: evaluate => evaluate_1d procedure , public :: destroy => destroy_1d procedure , public :: size_of => size_1d procedure , public :: integral => integral_1d procedure , public :: fintegral => fintegral_1d final :: finalize_1d end type bspline_1d type , extends ( bspline_class ), public :: bspline_2d !! Class for 2d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y real ( wp ), dimension (:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:), allocatable :: work_val_1 !! [[db2val] work array of dimension `ky` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db2val] work array of dimension `3_ip*max(kx,ky)` contains private generic , public :: initialize => initialize_2d_auto_knots , initialize_2d_specify_knots procedure :: initialize_2d_auto_knots procedure :: initialize_2d_specify_knots procedure , public :: evaluate => evaluate_2d procedure , public :: destroy => destroy_2d procedure , public :: size_of => size_2d final :: finalize_2d end type bspline_2d type , extends ( bspline_class ), public :: bspline_3d !! Class for 3d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z real ( wp ), dimension (:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:), allocatable :: work_val_1 !! [[db3val] work array of dimension `ky,kz` real ( wp ), dimension (:), allocatable :: work_val_2 !! [[db3val] work array of dimension `kz` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db3val] work array of dimension `3_ip*max(kx,ky,kz)` contains private generic , public :: initialize => initialize_3d_auto_knots , initialize_3d_specify_knots procedure :: initialize_3d_auto_knots procedure :: initialize_3d_specify_knots procedure , public :: evaluate => evaluate_3d procedure , public :: destroy => destroy_3d procedure , public :: size_of => size_3d final :: finalize_3d end type bspline_3d type , extends ( bspline_class ), public :: bspline_4d !! Class for 4d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q real ( wp ), dimension (:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:), allocatable :: work_val_1 !! [[db4val]] work array of dimension `ky,kz,kq` real ( wp ), dimension (:,:), allocatable :: work_val_2 !! [[db4val]] work array of dimension `kz,kq` real ( wp ), dimension (:), allocatable :: work_val_3 !! [[db4val]] work array of dimension `kq` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db4val]] work array of dimension `3_ip*max(kx,ky,kz,kq)` contains private generic , public :: initialize => initialize_4d_auto_knots , initialize_4d_specify_knots procedure :: initialize_4d_auto_knots procedure :: initialize_4d_specify_knots procedure , public :: evaluate => evaluate_4d procedure , public :: destroy => destroy_4d procedure , public :: size_of => size_4d final :: finalize_4d end type bspline_4d type , extends ( bspline_class ), public :: bspline_5d !! Class for 5d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r real ( wp ), dimension (:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:), allocatable :: work_val_1 !! [[db5val]] work array of dimension `ky,kz,kq,kr` real ( wp ), dimension (:,:,:), allocatable :: work_val_2 !! [[db5val]] work array of dimension `kz,kq,kr` real ( wp ), dimension (:,:), allocatable :: work_val_3 !! [[db5val]] work array of dimension `kq,kr` real ( wp ), dimension (:), allocatable :: work_val_4 !! [[db5val]] work array of dimension `kr` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db5val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr)` contains private generic , public :: initialize => initialize_5d_auto_knots , initialize_5d_specify_knots procedure :: initialize_5d_auto_knots procedure :: initialize_5d_specify_knots procedure , public :: evaluate => evaluate_5d procedure , public :: destroy => destroy_5d procedure , public :: size_of => size_5d final :: finalize_5d end type bspline_5d type , extends ( bspline_class ), public :: bspline_6d !! Class for 6d b-spline interpolation. private integer ( ip ) :: nx = 0_ip !! Number of x abcissae integer ( ip ) :: ny = 0_ip !! Number of y abcissae integer ( ip ) :: nz = 0_ip !! Number of z abcissae integer ( ip ) :: nq = 0_ip !! Number of q abcissae integer ( ip ) :: nr = 0_ip !! Number of r abcissae integer ( ip ) :: ns = 0_ip !! Number of s abcissae integer ( ip ) :: kx = 0_ip !! The order of spline pieces in x integer ( ip ) :: ky = 0_ip !! The order of spline pieces in y integer ( ip ) :: kz = 0_ip !! The order of spline pieces in z integer ( ip ) :: kq = 0_ip !! The order of spline pieces in q integer ( ip ) :: kr = 0_ip !! The order of spline pieces in r integer ( ip ) :: ks = 0_ip !! The order of spline pieces in s real ( wp ), dimension (:,:,:,:,:,:), allocatable :: bcoef !! array of coefficients of the b-spline interpolant real ( wp ), dimension (:), allocatable :: tx !! The knots in the x direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ty !! The knots in the y direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tz !! The knots in the z direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tq !! The knots in the q direction for the spline interpolant real ( wp ), dimension (:), allocatable :: tr !! The knots in the r direction for the spline interpolant real ( wp ), dimension (:), allocatable :: ts !! The knots in the s direction for the spline interpolant integer ( ip ) :: inbvy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvr = 1_ip !! internal variable used for efficient processing integer ( ip ) :: inbvs = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloy = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloz = 1_ip !! internal variable used for efficient processing integer ( ip ) :: iloq = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilor = 1_ip !! internal variable used for efficient processing integer ( ip ) :: ilos = 1_ip !! internal variable used for efficient processing real ( wp ), dimension (:,:,:,:,:), allocatable :: work_val_1 !! [[db6val]] work array of dimension `ky,kz,kq,kr,ks` real ( wp ), dimension (:,:,:,:), allocatable :: work_val_2 !! [[db6val]] work array of dimension `kz,kq,kr,ks` real ( wp ), dimension (:,:,:), allocatable :: work_val_3 !! [[db6val]] work array of dimension `kq,kr,ks` real ( wp ), dimension (:,:), allocatable :: work_val_4 !! [[db6val]] work array of dimension `kr,ks` real ( wp ), dimension (:), allocatable :: work_val_5 !! [[db6val]] work array of dimension `ks` real ( wp ), dimension (:), allocatable :: work_val_6 !! [[db6val]] work array of dimension `3_ip*max(kx,ky,kz,kq,kr,ks)` contains private generic , public :: initialize => initialize_6d_auto_knots , initialize_6d_specify_knots procedure :: initialize_6d_auto_knots procedure :: initialize_6d_specify_knots procedure , public :: evaluate => evaluate_6d procedure , public :: destroy => destroy_6d procedure , public :: size_of => size_6d final :: finalize_6d end type bspline_6d interface bspline_1d !! Constructor for [[bspline_1d(type)]] procedure :: bspline_1d_constructor_empty ,& bspline_1d_constructor_auto_knots ,& bspline_1d_constructor_specify_knots end interface interface bspline_2d !! Constructor for [[bspline_2d(type)]] procedure :: bspline_2d_constructor_empty ,& bspline_2d_constructor_auto_knots ,& bspline_2d_constructor_specify_knots end interface interface bspline_3d !! Constructor for [[bspline_3d(type)]] procedure :: bspline_3d_constructor_empty ,& bspline_3d_constructor_auto_knots ,& bspline_3d_constructor_specify_knots end interface interface bspline_4d !! Constructor for [[bspline_4d(type)]] procedure :: bspline_4d_constructor_empty ,& bspline_4d_constructor_auto_knots ,& bspline_4d_constructor_specify_knots end interface interface bspline_5d !! Constructor for [[bspline_5d(type)]] procedure :: bspline_5d_constructor_empty ,& bspline_5d_constructor_auto_knots ,& bspline_5d_constructor_specify_knots end interface interface bspline_6d !! Constructor for [[bspline_6d(type)]] procedure :: bspline_6d_constructor_empty ,& bspline_6d_constructor_auto_knots ,& bspline_6d_constructor_specify_knots end interface contains !***************************************************************************************** !***************************************************************************************** !> ! This routines returns true if the `iflag` code from the last ! routine called was `=0`. Maybe of the routines have output `iflag` ! variables, so they can be checked explicitly, or this routine ! can be used. ! ! If the class is initialized using a function constructor, then ! this is the only way to know if it was properly initialized, ! since those are pure functions with not output `iflag` arguments. ! ! If `status_ok=.false.`, then the error message can be ! obtained from the [[get_bspline_status_message]] routine. ! ! Note: after an error condition, the [[clear_bspline_flag]] routine ! can be called to reset the `iflag` to 0. elemental function status_ok ( me ) result ( ok ) implicit none class ( bspline_class ), intent ( in ) :: me logical :: ok ok = ( me % iflag == 0_ip ) end function status_ok !***************************************************************************************** !***************************************************************************************** !> ! This sets the `iflag` variable in the class to `0` ! (which indicates that everything is OK). It can be used ! after an error is encountered. elemental subroutine clear_bspline_flag ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % iflag = 0_ip end subroutine clear_bspline_flag !***************************************************************************************** !***************************************************************************************** !> ! Get the status message from a [[bspline_class]] routine call. ! ! If `iflag` is not included, then the one in the class is used (which ! corresponds to the last routine called.) ! Otherwise, it will convert the ! input `iflag` argument into the appropriate message. ! ! This is a wrapper for [[get_status_message]]. pure function get_bspline_status_message ( me , iflag ) result ( msg ) implicit none class ( bspline_class ), intent ( in ) :: me character ( len = :), allocatable :: msg !! status message associated with the flag integer ( ip ), intent ( in ), optional :: iflag !! the corresponding status code if ( present ( iflag )) then msg = get_status_message ( iflag ) else msg = get_status_message ( me % iflag ) end if end function get_bspline_status_message !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_1d]] structure in bits. pure function size_1d ( me ) result ( s ) implicit none class ( bspline_1d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 2_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) end function size_1d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_2d]] structure in bits. pure function size_2d ( me ) result ( s ) implicit none class ( bspline_2d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 6_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) end function size_2d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_3d]] structure in bits. pure function size_3d ( me ) result ( s ) implicit none class ( bspline_3d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 10_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) end function size_3d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_4d]] structure in bits. pure function size_4d ( me ) result ( s ) implicit none class ( bspline_4d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 14_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) end function size_4d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_5d]] structure in bits. pure function size_5d ( me ) result ( s ) implicit none class ( bspline_5d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 18_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) end function size_5d !***************************************************************************************** !***************************************************************************************** !> ! Actual size of a [[bspline_6d]] structure in bits. pure function size_6d ( me ) result ( s ) implicit none class ( bspline_6d ), intent ( in ) :: me integer ( ip ) :: s !! size of the structure in bits s = 2_ip * int_size + logical_size + 22_ip * int_size if ( allocated ( me % bcoef )) s = s + real_size * size ( me % bcoef , 1_ip , kind = ip ) * & size ( me % bcoef , 2_ip , kind = ip ) * & size ( me % bcoef , 3_ip , kind = ip ) * & size ( me % bcoef , 4_ip , kind = ip ) * & size ( me % bcoef , 5_ip , kind = ip ) * & size ( me % bcoef , 6 , kind = ip ) if ( allocated ( me % tx )) s = s + real_size * size ( me % tx , kind = ip ) if ( allocated ( me % ty )) s = s + real_size * size ( me % ty , kind = ip ) if ( allocated ( me % tz )) s = s + real_size * size ( me % tz , kind = ip ) if ( allocated ( me % tq )) s = s + real_size * size ( me % tq , kind = ip ) if ( allocated ( me % tr )) s = s + real_size * size ( me % tr , kind = ip ) if ( allocated ( me % ts )) s = s + real_size * size ( me % ts , kind = ip ) if ( allocated ( me % work_val_1 )) s = s + real_size * size ( me % work_val_1 , 1_ip , kind = ip ) * & size ( me % work_val_1 , 2_ip , kind = ip ) * & size ( me % work_val_1 , 3_ip , kind = ip ) * & size ( me % work_val_1 , 4_ip , kind = ip ) * & size ( me % work_val_1 , 5_ip , kind = ip ) if ( allocated ( me % work_val_2 )) s = s + real_size * size ( me % work_val_2 , 1_ip , kind = ip ) * & size ( me % work_val_2 , 2_ip , kind = ip ) * & size ( me % work_val_2 , 3_ip , kind = ip ) * & size ( me % work_val_2 , 4_ip , kind = ip ) if ( allocated ( me % work_val_3 )) s = s + real_size * size ( me % work_val_3 , 1_ip , kind = ip ) * & size ( me % work_val_3 , 2_ip , kind = ip ) * & size ( me % work_val_3 , 3_ip , kind = ip ) if ( allocated ( me % work_val_4 )) s = s + real_size * size ( me % work_val_4 , 1_ip , kind = ip ) * & size ( me % work_val_4 , 2_ip , kind = ip ) if ( allocated ( me % work_val_5 )) s = s + real_size * size ( me % work_val_5 , kind = ip ) if ( allocated ( me % work_val_6 )) s = s + real_size * size ( me % work_val_6 , kind = ip ) end function size_6d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for contents of the base [[bspline_class]] class. ! (this routine is called by the extended classes). pure subroutine destroy_base ( me ) implicit none class ( bspline_class ), intent ( inout ) :: me me % inbvx = 1_ip me % iflag = 1_ip me % initialized = . false . me % extrap = . false . end subroutine destroy_base !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_1d]] class. pure subroutine destroy_1d ( me ) implicit none class ( bspline_1d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % kx = 0_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) end subroutine destroy_1d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_2d]] class. pure subroutine destroy_2d ( me ) implicit none class ( bspline_2d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % kx = 0_ip me % ky = 0_ip me % inbvy = 1_ip me % iloy = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) end subroutine destroy_2d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_3d]] class. pure subroutine destroy_3d ( me ) implicit none class ( bspline_3d ), intent ( inout ) :: me call me % destroy_base () me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % iloy = 1_ip me % iloz = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) end subroutine destroy_3d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_4d]] class. pure subroutine destroy_4d ( me ) implicit none class ( bspline_4d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) end subroutine destroy_4d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_5d]] class. pure subroutine destroy_5d ( me ) implicit none class ( bspline_5d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) end subroutine destroy_5d !***************************************************************************************** !***************************************************************************************** !> ! Destructor for [[bspline_6d]] class. pure subroutine destroy_6d ( me ) implicit none class ( bspline_6d ), intent ( inout ) :: me me % nx = 0_ip me % ny = 0_ip me % nz = 0_ip me % nq = 0_ip me % nr = 0_ip me % ns = 0_ip me % kx = 0_ip me % ky = 0_ip me % kz = 0_ip me % kq = 0_ip me % kr = 0_ip me % ks = 0_ip me % inbvy = 1_ip me % inbvz = 1_ip me % inbvq = 1_ip me % inbvr = 1_ip me % inbvs = 1_ip me % iloy = 1_ip me % iloz = 1_ip me % iloq = 1_ip me % ilor = 1_ip me % ilos = 1_ip if ( allocated ( me % bcoef )) deallocate ( me % bcoef ) if ( allocated ( me % tx )) deallocate ( me % tx ) if ( allocated ( me % ty )) deallocate ( me % ty ) if ( allocated ( me % tz )) deallocate ( me % tz ) if ( allocated ( me % tq )) deallocate ( me % tq ) if ( allocated ( me % tr )) deallocate ( me % tr ) if ( allocated ( me % ts )) deallocate ( me % ts ) if ( allocated ( me % work_val_1 )) deallocate ( me % work_val_1 ) if ( allocated ( me % work_val_2 )) deallocate ( me % work_val_2 ) if ( allocated ( me % work_val_3 )) deallocate ( me % work_val_3 ) if ( allocated ( me % work_val_4 )) deallocate ( me % work_val_4 ) if ( allocated ( me % work_val_5 )) deallocate ( me % work_val_5 ) if ( allocated ( me % work_val_6 )) deallocate ( me % work_val_6 ) end subroutine destroy_6d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_1d]] class. Just a wrapper for [[destroy_1d]]. pure elemental subroutine finalize_1d ( me ) type ( bspline_1d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_1d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_2d]] class. Just a wrapper for [[destroy_2d]]. pure elemental subroutine finalize_2d ( me ) type ( bspline_2d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_2d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_3d]] class. Just a wrapper for [[destroy_3d]]. pure elemental subroutine finalize_3d ( me ) type ( bspline_3d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_3d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_4d]] class. Just a wrapper for [[destroy_4d]]. pure elemental subroutine finalize_4d ( me ) type ( bspline_4d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_4d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_5d]] class. Just a wrapper for [[destroy_5d]]. pure elemental subroutine finalize_5d ( me ) type ( bspline_5d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_5d !***************************************************************************************** !***************************************************************************************** !> ! Finalizer for [[bspline_6d]] class. Just a wrapper for [[destroy_6d]]. pure elemental subroutine finalize_6d ( me ) type ( bspline_6d ), intent ( inout ) :: me ; call me % destroy () end subroutine finalize_6d !***************************************************************************************** !***************************************************************************************** !> ! Sets the `extrap` flag in the class. pure subroutine set_extrap_flag ( me , extrap ) implicit none class ( bspline_class ), intent ( inout ) :: me logical , intent ( in ), optional :: extrap !! if not present, then False is used if ( present ( extrap )) then me % extrap = extrap else me % extrap = . false . end if end subroutine set_extrap_flag !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_1d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. pure elemental function bspline_1d_constructor_empty () result ( me ) implicit none type ( bspline_1d ) :: me end function bspline_1d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_1d]] type (auto knots). ! This is a wrapper for [[initialize_1d_auto_knots]]. pure function bspline_1d_constructor_auto_knots ( x , fcn , kx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_auto_knots ( me , x , fcn , kx , me % iflag , extrap ) end function bspline_1d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_1d]] type (user-specified knots). ! This is a wrapper for [[initialize_1d_specify_knots]]. pure function bspline_1d_constructor_specify_knots ( x , fcn , kx , tx , extrap ) result ( me ) implicit none type ( bspline_1d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_1d_specify_knots ( me , x , fcn , kx , tx , me % iflag , extrap ) end function bspline_1d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_1d]] type (with automatically-computed knots). ! This is a wrapper for [[db1ink]]. pure subroutine initialize_1d_auto_knots ( me , x , fcn , kx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) iknot = 0_ip !knot sequence chosen by db1ink call db1ink ( x , nx , fcn , kx , iknot , me % tx , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_1d]] type (with user-specified knots). ! This is a wrapper for [[db1ink]]. pure subroutine initialize_1d_specify_knots ( me , x , fcn , kx , tx , iflag , extrap ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: fcn !! `(nx)` array of function values to interpolate. `fcn(i)` should !! contain the function value at the point `x(i)` integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx call me % destroy () nx = size ( x , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx , iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % kx = kx allocate ( me % tx ( nx + kx )) allocate ( me % bcoef ( nx )) allocate ( me % work_val_1 ( 3_ip * kx )) me % tx = tx call db1ink ( x , nx , fcn , kx , 1_ip , me % tx , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_1d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_1d]] interpolate. This is a wrapper for [[db1val]]. pure subroutine evaluate_1d ( me , xval , idx , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1val]]) if ( me % initialized ) then call db1val ( xval , idx , me % tx , me % nx , me % kx , me % bcoef , f , iflag ,& me % inbvx , me % work_val_1 , extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_1d !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_1d]] definite integral. This is a wrapper for [[db1sqad]]. pure subroutine integral_1d ( me , x1 , x2 , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( out ) :: f !! integral of the b-spline over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1sqad ( me % tx , me % bcoef , me % nx , me % kx , x1 , x2 , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine integral_1d !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_1d]] definite integral. This is a wrapper for [[db1fqad]]. subroutine fintegral_1d ( me , fun , idx , x1 , x2 , tol , f , iflag ) implicit none class ( bspline_1d ), intent ( inout ) :: me procedure ( b1fqad_func ) :: fun !! external function of one argument for the !! integrand `bf(x)=fun(x)*dbvalu(tx,bcoef,nx,kx,idx,x,inbv)` integer ( ip ), intent ( in ) :: idx !! order of the spline derivative, `0 <= idx <= k-1` !! `idx=0` gives the spline function real ( wp ), intent ( in ) :: x1 !! left point of interval real ( wp ), intent ( in ) :: x2 !! right point of interval real ( wp ), intent ( in ) :: tol !! desired accuracy for the quadrature real ( wp ), intent ( out ) :: f !! integral of `bf(x)` over [x_1, x_2] integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db1sqad]]) if ( me % initialized ) then call db1fqad ( fun , me % tx , me % bcoef , me % nx , me % kx , idx , x1 , x2 , tol , f , iflag , me % work_val_1 ) else iflag = 1_ip end if me % iflag = iflag end subroutine fintegral_1d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_2d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_2d_constructor_empty () result ( me ) implicit none type ( bspline_2d ) :: me end function bspline_2d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_2d]] type (auto knots). ! This is a wrapper for [[initialize_2d_auto_knots]]. pure function bspline_2d_constructor_auto_knots ( x , y , fcn , kx , ky , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , me % iflag , extrap ) end function bspline_2d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_2d]] type (user-specified knots). ! This is a wrapper for [[initialize_2d_specify_knots]]. pure function bspline_2d_constructor_specify_knots ( x , y , fcn , kx , ky , tx , ty , extrap ) result ( me ) implicit none type ( bspline_2d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , me % iflag , extrap ) end function bspline_2d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_2d]] type (with automatically-computed knots). ! This is a wrapper for [[db2ink]]. pure subroutine initialize_2d_auto_knots ( me , x , y , fcn , kx , ky , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) iknot = 0_ip !knot sequence chosen by db2ink call db2ink ( x , nx , y , ny , fcn , kx , ky , iknot , me % tx , me % ty , me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_2d]] type (with user-specified knots). ! This is a wrapper for [[db2ink]]. pure subroutine initialize_2d_specify_knots ( me , x , y , fcn , kx , ky , tx , ty , iflag , extrap ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:,:), intent ( in ) :: fcn !! `(nx,ny)` matrix of function values to interpolate. !! `fcn(i,j)` should contain the function value at the !! point (`x(i)`,`y(j)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % kx = kx me % ky = ky allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % bcoef ( nx , ny )) allocate ( me % work_val_1 ( ky )) allocate ( me % work_val_2 ( 3_ip * max ( kx , ky ))) me % tx = tx me % ty = ty call db2ink ( x , nx , y , ny , fcn , kx , ky , 1_ip , me % tx , me % ty , me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_2d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_2d]] interpolate. This is a wrapper for [[db2val]]. pure subroutine evaluate_2d ( me , xval , yval , idx , idy , f , iflag ) implicit none class ( bspline_2d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db2val]]) if ( me % initialized ) then call db2val ( xval , yval ,& idx , idy ,& me % tx , me % ty ,& me % nx , me % ny ,& me % kx , me % ky ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % iloy ,& me % work_val_1 , me % work_val_2 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_2d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_3d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_3d_constructor_empty () result ( me ) implicit none type ( bspline_3d ) :: me end function bspline_3d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_3d]] type (auto knots). ! This is a wrapper for [[initialize_3d_auto_knots]]. pure function bspline_3d_constructor_auto_knots ( x , y , z , fcn , kx , ky , kz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , me % iflag , extrap ) end function bspline_3d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_3d]] type (user-specified knots). ! This is a wrapper for [[initialize_3d_specify_knots]]. pure function bspline_3d_constructor_specify_knots ( x , y , z , fcn , kx , ky , kz , tx , ty , tz , extrap ) result ( me ) implicit none type ( bspline_3d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , me % iflag , extrap ) end function bspline_3d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_3d]] type (with automatically-computed knots). ! This is a wrapper for [[db3ink]]. pure subroutine initialize_3d_auto_knots ( me , x , y , z , fcn , kx , ky , kz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) iknot = 0_ip !knot sequence chosen by db3ink call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& iknot ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_3d]] type (with user-specified knots). ! This is a wrapper for [[db3ink]]. pure subroutine initialize_3d_specify_knots ( me , x , y , z , fcn , kx , ky , kz , tx , ty , tz , iflag , extrap ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz)` matrix of function values to interpolate. !! `fcn(i,j,k)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % kx = kx me % ky = ky me % kz = kz allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % bcoef ( nx , ny , nz )) allocate ( me % work_val_1 ( ky , kz )) allocate ( me % work_val_2 ( kz )) allocate ( me % work_val_3 ( 3_ip * max ( kx , ky , kz ))) me % tx = tx me % ty = ty me % tz = tz call db3ink ( x , nx , y , ny , z , nz ,& fcn ,& kx , ky , kz ,& 1_ip ,& me % tx , me % ty , me % tz ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_3d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_3d]] interpolate. This is a wrapper for [[db3val]]. pure subroutine evaluate_3d ( me , xval , yval , zval , idx , idy , idz , f , iflag ) implicit none class ( bspline_3d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db3val]]) if ( me % initialized ) then call db3val ( xval , yval , zval ,& idx , idy , idz ,& me % tx , me % ty , me % tz ,& me % nx , me % ny , me % nz ,& me % kx , me % ky , me % kz ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz ,& me % iloy , me % iloz ,& me % work_val_1 , me % work_val_2 , me % work_val_3 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_3d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_4d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_4d_constructor_empty () result ( me ) implicit none type ( bspline_4d ) :: me end function bspline_4d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_4d]] type (auto knots). ! This is a wrapper for [[initialize_4d_auto_knots]]. pure function bspline_4d_constructor_auto_knots ( x , y , z , q , fcn , kx , ky , kz , kq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , me % iflag , extrap ) end function bspline_4d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_4d]] type (user-specified knots). ! This is a wrapper for [[initialize_4d_specify_knots]]. pure function bspline_4d_constructor_specify_knots ( x , y , z , q , fcn , kx , ky , kz , kq ,& tx , ty , tz , tq , extrap ) result ( me ) implicit none type ( bspline_4d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_4d_specify_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , tx , ty , tz , tq , me % iflag , extrap ) end function bspline_4d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_4d]] type (with automatically-computed knots). ! This is a wrapper for [[db4ink]]. pure subroutine initialize_4d_auto_knots ( me , x , y , z , q , fcn , kx , ky , kz , kq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) iknot = 0_ip !knot sequence chosen by db4ink call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& iknot ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_4d]] type (with user-specified knots). ! This is a wrapper for [[db4ink]]. pure subroutine initialize_4d_specify_knots ( me , x , y , z , q , fcn ,& kx , ky , kz , kq , tx , ty , tz , tq , iflag , extrap ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq)` matrix of function values to interpolate. !! `fcn(i,j,k,l)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % kx = kx me % ky = ky me % kz = kz me % kq = kq allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % bcoef ( nx , ny , nz , nq )) allocate ( me % work_val_1 ( ky , kz , kq )) allocate ( me % work_val_2 ( kz , kq )) allocate ( me % work_val_3 ( kq )) allocate ( me % work_val_4 ( 3_ip * max ( kx , ky , kz , kq ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq call db4ink ( x , nx , y , ny , z , nz , q , nq ,& fcn ,& kx , ky , kz , kq ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_4d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_4d]] interpolate. This is a wrapper for [[db4val]]. pure subroutine evaluate_4d ( me , xval , yval , zval , qval , idx , idy , idz , idq , f , iflag ) implicit none class ( bspline_4d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db4val]]) if ( me % initialized ) then call db4val ( xval , yval , zval , qval ,& idx , idy , idz , idq ,& me % tx , me % ty , me % tz , me % tq ,& me % nx , me % ny , me % nz , me % nq ,& me % kx , me % ky , me % kz , me % kq ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq ,& me % iloy , me % iloz , me % iloq ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_4d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_5d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_5d_constructor_empty () result ( me ) implicit none type ( bspline_5d ) :: me end function bspline_5d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_5d]] type (auto knots). ! This is a wrapper for [[initialize_5d_auto_knots]]. pure function bspline_5d_constructor_auto_knots ( x , y , z , q , r , fcn , kx , ky , kz , kq , kr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , me % iflag , extrap ) end function bspline_5d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_5d]] type (user-specified knots). ! This is a wrapper for [[initialize_5d_specify_knots]]. pure function bspline_5d_constructor_specify_knots ( x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , extrap ) result ( me ) implicit none type ( bspline_5d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_5d_specify_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , tx , ty , tz , tq , tr , me % iflag , extrap ) end function bspline_5d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_5d]] type (with automatically-computed knots). ! This is a wrapper for [[db5ink]]. pure subroutine initialize_5d_auto_knots ( me , x , y , z , q , r , fcn , kx , ky , kz , kq , kr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) iknot = 0_ip !knot sequence chosen by db5ink call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_5d]] type (with user-specified knots). ! This is a wrapper for [[db5ink]]. pure subroutine initialize_5d_specify_knots ( me , x , y , z , q , r , fcn ,& kx , ky , kz , kq , kr ,& tx , ty , tz , tq , tr , iflag , extrap ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % bcoef ( nx , ny , nz , nq , nr )) allocate ( me % work_val_1 ( ky , kz , kq , kr )) allocate ( me % work_val_2 ( kz , kq , kr )) allocate ( me % work_val_3 ( kq , kr )) allocate ( me % work_val_4 ( kr )) allocate ( me % work_val_5 ( 3_ip * max ( kx , ky , kz , kq , kr ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr call db5ink ( x , nx , y , ny , z , nz , q , nq , r , nr ,& fcn ,& kx , ky , kz , kq , kr ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_5d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_5d]] interpolate. This is a wrapper for [[db5val]]. pure subroutine evaluate_5d ( me , xval , yval , zval , qval , rval , idx , idy , idz , idq , idr , f , iflag ) implicit none class ( bspline_5d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db5val]]) if ( me % initialized ) then call db5val ( xval , yval , zval , qval , rval ,& idx , idy , idz , idq , idr ,& me % tx , me % ty , me % tz , me % tq , me % tr ,& me % nx , me % ny , me % nz , me % nq , me % nr ,& me % kx , me % ky , me % kz , me % kq , me % kr ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr ,& me % iloy , me % iloz , me % iloq , me % ilor ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_5d !***************************************************************************************** !***************************************************************************************** !> ! It returns an empty [[bspline_6d]] type. Note that INITIALIZE still ! needs to be called before it can be used. ! Not really that useful except perhaps in some OpenMP applications. elemental function bspline_6d_constructor_empty () result ( me ) implicit none type ( bspline_6d ) :: me end function bspline_6d_constructor_empty !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_6d]] type (auto knots). ! This is a wrapper for [[initialize_6d_auto_knots]]. pure function bspline_6d_constructor_auto_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn , kx , ky , kz , kq , kr , ks , me % iflag , extrap ) end function bspline_6d_constructor_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Constructor for a [[bspline_6d]] type (user-specified knots). ! This is a wrapper for [[initialize_6d_specify_knots]]. pure function bspline_6d_constructor_specify_knots ( x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , extrap ) result ( me ) implicit none type ( bspline_6d ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) call initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , me % iflag , extrap ) end function bspline_6d_constructor_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_6d]] type (with automatically-computed knots). ! This is a wrapper for [[db6ink]]. pure subroutine initialize_6d_auto_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: iknot integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) iknot = 0_ip !knot sequence chosen by db6ink call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& iknot ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) if ( iflag == 0_ip ) then call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_auto_knots !***************************************************************************************** !***************************************************************************************** !> ! Initialize a [[bspline_6d]] type (with user-specified knots). ! This is a wrapper for [[db6ink]]. pure subroutine initialize_6d_specify_knots ( me , x , y , z , q , r , s , fcn ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag , extrap ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), dimension (:), intent ( in ) :: x !! `(nx)` array of x abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: y !! `(ny)` array of y abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: z !! `(nz)` array of z abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: q !! `(nq)` array of q abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: r !! `(nr)` array of r abcissae. Must be strictly increasing. real ( wp ), dimension (:), intent ( in ) :: s !! `(ns)` array of s abcissae. Must be strictly increasing. real ( wp ), dimension (:,:,:,:,:,:), intent ( in ) :: fcn !! `(nx,ny,nz,nq,nr,ns)` matrix of function values to interpolate. !! `fcn(i,j,k,l,m,n)` should contain the function value at the !! point (`x(i)`,`y(j)`,`z(k)`,`q(l)`,`r(m)`,`s(n)`) integer ( ip ), intent ( in ) :: kx !! The order of spline pieces in x !! ( 2 \\le k_x < n_x ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ky !! The order of spline pieces in y !! ( 2 \\le k_y < n_y ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kz !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kq !! The order of spline pieces in q !! ( 2 \\le k_q < n_q ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: kr !! The order of spline pieces in r !! ( 2 \\le k_r < n_r ) !! (order = polynomial degree + 1) integer ( ip ), intent ( in ) :: ks !! The order of spline pieces in z !! ( 2 \\le k_z < n_z ) !! (order = polynomial degree + 1) real ( wp ), dimension (:), intent ( in ) :: tx !! The `(nx+kx)` knots in the x direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ty !! The `(ny+ky)` knots in the y direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tz !! The `(nz+kz)` knots in the z direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tq !! The `(nq+kq)` knots in the q direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: tr !! The `(nr+kr)` knots in the r direction !! for the spline interpolant. !! Must be non-decreasing. real ( wp ), dimension (:), intent ( in ) :: ts !! The `(ns+ks)` knots in the s direction !! for the spline interpolant. !! Must be non-decreasing. integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6ink]]) logical , intent ( in ), optional :: extrap !! if true, then extrapolation is allowed !! (default is false) integer ( ip ) :: nx , ny , nz , nq , nr , ns call me % destroy () nx = size ( x , kind = ip ) ny = size ( y , kind = ip ) nz = size ( z , kind = ip ) nq = size ( q , kind = ip ) nr = size ( r , kind = ip ) ns = size ( s , kind = ip ) call check_knot_vectors_sizes ( nx = nx , kx = kx , tx = tx ,& ny = ny , ky = ky , ty = ty ,& nz = nz , kz = kz , tz = tz ,& nq = nq , kq = kq , tq = tq ,& nr = nr , kr = kr , tr = tr ,& ns = ns , ks = ks , ts = ts ,& iflag = iflag ) if ( iflag == 0_ip ) then me % nx = nx me % ny = ny me % nz = nz me % nq = nq me % nr = nr me % ns = ns me % kx = kx me % ky = ky me % kz = kz me % kq = kq me % kr = kr me % ks = ks allocate ( me % tx ( nx + kx )) allocate ( me % ty ( ny + ky )) allocate ( me % tz ( nz + kz )) allocate ( me % tq ( nq + kq )) allocate ( me % tr ( nr + kr )) allocate ( me % ts ( ns + ks )) allocate ( me % bcoef ( nx , ny , nz , nq , nr , ns )) allocate ( me % work_val_1 ( ky , kz , kq , kr , ks )) allocate ( me % work_val_2 ( kz , kq , kr , ks )) allocate ( me % work_val_3 ( kq , kr , ks )) allocate ( me % work_val_4 ( kr , ks )) allocate ( me % work_val_5 ( ks )) allocate ( me % work_val_6 ( 3_ip * max ( kx , ky , kz , kq , kr , ks ))) me % tx = tx me % ty = ty me % tz = tz me % tq = tq me % tr = tr me % ts = ts call db6ink ( x , nx , y , ny , z , nz , q , nq , r , nr , s , ns ,& fcn ,& kx , ky , kz , kq , kr , ks ,& 1_ip ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % bcoef , iflag ) call me % set_extrap_flag ( extrap ) end if me % initialized = iflag == 0_ip me % iflag = iflag end subroutine initialize_6d_specify_knots !***************************************************************************************** !***************************************************************************************** !> ! Evaluate a [[bspline_6d]] interpolate. This is a wrapper for [[db6val]]. pure subroutine evaluate_6d ( me , xval , yval , zval , qval , rval , sval , idx , idy , idz , idq , idr , ids , f , iflag ) implicit none class ( bspline_6d ), intent ( inout ) :: me real ( wp ), intent ( in ) :: xval !! x coordinate of evaluation point. real ( wp ), intent ( in ) :: yval !! y coordinate of evaluation point. real ( wp ), intent ( in ) :: zval !! z coordinate of evaluation point. real ( wp ), intent ( in ) :: qval !! q coordinate of evaluation point. real ( wp ), intent ( in ) :: rval !! r coordinate of evaluation point. real ( wp ), intent ( in ) :: sval !! s coordinate of evaluation point. integer ( ip ), intent ( in ) :: idx !! x derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idy !! y derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idz !! z derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idq !! q derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: idr !! r derivative of piecewise polynomial to evaluate. integer ( ip ), intent ( in ) :: ids !! s derivative of piecewise polynomial to evaluate. real ( wp ), intent ( out ) :: f !! interpolated value integer ( ip ), intent ( out ) :: iflag !! status flag (see [[db6val]]) if ( me % initialized ) then call db6val ( xval , yval , zval , qval , rval , sval ,& idx , idy , idz , idq , idr , ids ,& me % tx , me % ty , me % tz , me % tq , me % tr , me % ts ,& me % nx , me % ny , me % nz , me % nq , me % nr , me % ns ,& me % kx , me % ky , me % kz , me % kq , me % kr , me % ks ,& me % bcoef , f , iflag ,& me % inbvx , me % inbvy , me % inbvz , me % inbvq , me % inbvr , me % inbvs ,& me % iloy , me % iloz , me % iloq , me % ilor , me % ilos ,& me % work_val_1 , me % work_val_2 , me % work_val_3 , me % work_val_4 , me % work_val_5 , me % work_val_6 ,& extrap = me % extrap ) else iflag = 1_ip end if me % iflag = iflag end subroutine evaluate_6d !***************************************************************************************** !***************************************************************************************** !> ! Error checks for the user-specified knot vector sizes. ! !@note If more than one is the wrong size, then the `iflag` error code will ! correspond to the one with the highest rank. pure subroutine check_knot_vectors_sizes ( nx , ny , nz , nq , nr , ns ,& kx , ky , kz , kq , kr , ks ,& tx , ty , tz , tq , tr , ts , iflag ) implicit none integer ( ip ), intent ( in ), optional :: nx integer ( ip ), intent ( in ), optional :: ny integer ( ip ), intent ( in ), optional :: nz integer ( ip ), intent ( in ), optional :: nq integer ( ip ), intent ( in ), optional :: nr integer ( ip ), intent ( in ), optional :: ns integer ( ip ), intent ( in ), optional :: kx integer ( ip ), intent ( in ), optional :: ky integer ( ip ), intent ( in ), optional :: kz integer ( ip ), intent ( in ), optional :: kq integer ( ip ), intent ( in ), optional :: kr integer ( ip ), intent ( in ), optional :: ks real ( wp ), dimension (:), intent ( in ), optional :: tx real ( wp ), dimension (:), intent ( in ), optional :: ty real ( wp ), dimension (:), intent ( in ), optional :: tz real ( wp ), dimension (:), intent ( in ), optional :: tq real ( wp ), dimension (:), intent ( in ), optional :: tr real ( wp ), dimension (:), intent ( in ), optional :: ts integer ( ip ), intent ( out ) :: iflag !! 0 if everything is OK iflag = 0_ip if ( present ( nx ) . and . present ( kx ) . and . present ( tx )) then if ( size ( tx , kind = ip ) /= ( nx + kx )) then iflag = 501_ip ! tx is not the correct size (nx+kx) end if end if if ( present ( ny ) . and . present ( ky ) . and . present ( ty )) then if ( size ( ty , kind = ip ) /= ( ny + ky )) then iflag = 502_ip ! ty is not the correct size (ny+ky) end if end if if ( present ( nz ) . and . present ( kz ) . and . present ( tz )) then if ( size ( tz , kind = ip ) /= ( nz + kz )) then iflag = 503_ip ! tz is not the correct size (nz+kz) end if end if if ( present ( nq ) . and . present ( kq ) . and . present ( tq )) then if ( size ( tq , kind = ip ) /= ( nq + kq )) then iflag = 504_ip ! tq is not the correct size (nq+kq) end if end if if ( present ( nr ) . and . present ( kr ) . and . present ( tr )) then if ( size ( tr , kind = ip ) /= ( nr + kr )) then iflag = 505_ip ! tr is not the correct size (nr+kr) end if end if if ( present ( ns ) . and . present ( ks ) . and . present ( ts )) then if ( size ( ts , kind = ip ) /= ( ns + ks )) then iflag = 506_ip ! ts is not the correct size (ns+ks) end if end if end subroutine check_knot_vectors_sizes !***************************************************************************************** !***************************************************************************************** end module bspline_oo_module !*****************************************************************************************","tags":"","loc":"sourcefile/bspline_oo_module.f90.html"}]} \ No newline at end of file diff --git a/type/bspline_class.html b/type/bspline_class.html index df87b1b..a38e79e 100644 --- a/type/bspline_class.html +++ b/type/bspline_class.html @@ -223,7 +223,7 @@

      Inherited by

      - + type~bspline_2d->type~bspline_class @@ -238,7 +238,7 @@

      Inherited by

             - + type~bspline_3d->type~bspline_class @@ -253,7 +253,7 @@

      Inherited by

             - + type~bspline_4d->type~bspline_class @@ -268,7 +268,7 @@

      Inherited by

             - + type~bspline_5d->type~bspline_class @@ -283,7 +283,7 @@

      Inherited by

             - + type~bspline_6d->type~bspline_class