diff --git a/.github/actions/tests-module-aerodyn/action.yml b/.github/actions/tests-module-aerodyn/action.yml index 950663ab85..3dd23d6c44 100644 --- a/.github/actions/tests-module-aerodyn/action.yml +++ b/.github/actions/tests-module-aerodyn/action.yml @@ -14,7 +14,7 @@ runs: - run: | if [[ ${{ inputs.test-target }} == "unit" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -R fvw_utest + ctest -VV -R aerodyn_utest fi if [[ ${{ inputs.test-target }} == "regression" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then diff --git a/docs/source/testing/unit_test.rst b/docs/source/testing/unit_test.rst index 314cc04466..0b3cb15a0a 100644 --- a/docs/source/testing/unit_test.rst +++ b/docs/source/testing/unit_test.rst @@ -8,10 +8,8 @@ tests. Through robust testing practices, the entire OpenFAST community can understand the intention behind code blocks and debug or expand functionality quicker and with more confidence and stability. -Unit testing in OpenFAST modules is accomplished through `pFUnit `__. -This framework provides a Fortran abstraction to the popular -`xUnit `__ structure. pFUnit is compiled -along with OpenFAST through CMake when the CMake variable ``BUILD_TESTING`` is +Unit testing in OpenFAST modules is accomplished through `test-drive `__. +test-drive is compiled along with OpenFAST through CMake when the CMake variable ``BUILD_TESTING`` is turned on (default off) and the CMake variable ``BUILD_UNIT_TESTING`` is on (turned on by default when ``BUILD_TEST`` is on). @@ -22,9 +20,8 @@ Dependencies ------------ The following packages are required for unit testing: -- Python 3.7+, <3.12 - CMake -- pFUnit - Included in OpenFAST repo through a git-submodule +- test-drive - Included in OpenFAST repo in unit_test/test-drive Compiling --------- @@ -39,7 +36,7 @@ framework named ``[module]_utest``. Then, ``make`` the target to test: make beamdyn_utest This creates a unit test executable at -``openfast/build/unit_tests/beamdyn/beamdyn_utest``. +``openfast/build/unit_tests/beamdyn_utest``. Executing --------- @@ -47,43 +44,34 @@ To execute a module's unit test, simply run the unit test binary. For example: .. code-block:: bash - >>>$ ./openfast/build/unit_tests/beamdyn/beamdyn_utest - ............. - Time: 0.018 seconds + >>>$ ./openfast/build/unit_tests/beamdyn_utest + All tests PASSED - OK - (14 tests) - -pFUnit will display a ``.`` for each unit test successfully completed -and a ``F`` for each failing test. If any tests do fail, the failure -criteria will be displayed listing which particular value caused -the failure. Failure cases display the following output: +the pass or fail status is provided for each test as it's run. An error message is output when the test fails. +Failure cases display the following output: .. code-block:: bash - >>>$ ./unit_tests/beamdyn/beamdyn_utest - .....F....... - Time: 0.008 seconds - - Failure - in: - test_BD_CrvMatrixH_suite.test_BD_CrvMatrixH - Location: - [test_BD_CrvMatrixH.F90:48] - simple rotation with known parameters: Pi on xaxis expected +0.5000000 but found: +0.4554637; difference: |+0.4453627E-01| > tolerance:+0.1000000E-13; first difference at element [1, 1]. - - FAILURES!!! - Tests run: 13, Failures: 1, Errors: 0 + >>>$ ./unit_tests/beamdyn_utest + # Testing: Crv + Starting test_BD_CheckRotMat ... (1/6) + ... test_BD_CheckRotMat [PASSED] + Starting test_BD_ComputeIniNodalCrv ... (2/6) + ... test_BD_ComputeIniNodalCrv [PASSED] + Starting test_BD_CrvCompose ... (3/6) + ... test_BD_CrvCompose [PASSED] + Starting test_BD_CrvExtractCrv ... (4/6) + ... test_BD_CrvExtractCrv [PASSED] + Starting test_BD_CrvMatrixH ... (5/6) + [Fatal] Uncaught error + Code: 1 Message: A(1,1) simple rotation with known parameters: Pi on xaxis: Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_DIVIDE_BY_ZERO - ERROR STOP *** Encountered 1 or more failures/errors during testing. *** + ERROR STOP Error termination. Backtrace: - #0 0x1073b958c - #1 0x1073ba295 - #2 0x1073bb1b6 - #3 0x106ecdd4f - #4 0x1063fabee - #5 0x10706691e + #0 0xffff9f70d08b in ??? + #1 0xffff9f70ddb3 in ??? + #2 0xffff9f70f333 in ??? Adding unit tests ----------------- @@ -104,31 +92,22 @@ structured as │ ├── SampleDyn.f90 │ └── SampleDyn_Subs.f90 └── tests/ - ├── test_SampleDyn_Subroutine1.F90 - ├── test_SampleDyn_Subroutine2.F90 - └── test_SampleDyn_Subroutine3.F90 - -Each unit test must be contained in a unique file called -``test_[SUBROUTINE].F90`` where ``[SUBROUTINE]`` is the code block being -tested. The new files should contain a Fortran `module` which itself -contains a Fortran `subroutine` for each specific test case. Generally, -multiple tests will be required to fully test one subroutine. - -Finally, update the CMake configuration for building a module's unit -test executable by copying an existing unit test CMake configuration -into a new module directory: - -.. code-block:: bash - - cp -r openfast/unit_tests/beamdyn openfast/unit_tests/[module] - -Then, modify the new ``CMakeLists.txt`` with the appropriate list of test -subroutines and module name variables. - -For reference, a template unit test file is included at -``openfast/unit_tests/test_SUBROUTINE.F90``. Each unit test should fully test -the target code block. If full test coverage is not easily achievable, it may -be an indication that refactoring would be beneficial. + ├── sampledyn_utest.F90 + ├── test_SampleDyn_Feature1.F90 + ├── test_SampleDyn_Feature2.F90 + └── test_SampleDyn_Feature3.F90 + +Each unit test file must contain a module that exports a function which populates +a list of unit tests in accordance with the ``test-drive`` documentation. These modules +contain subroutines which take an ``error`` argument that is populated by the ``check`` +subroutine provided by ``test-drive``. The ``sampledyn_utest.F90`` collects all of the +unit tests lists from the adjacent modules and runs them. These programs are compiled +via the ``unit_tests/CMakeLists.txt`` file so all relevant modules and programs are +specified there. + +Refer to existing unit tests for the ``BeamDyn`` or ``NWTC Library`` unit tests for examples +of how to structure and build the unit test drivers. Also review the ``test-drive`` documentation at +`test-drive `__. Some useful topics to consider when developing and testing for OpenFAST are: diff --git a/modules/aerodyn/tests/aerodyn_utest.F90 b/modules/aerodyn/tests/aerodyn_utest.F90 new file mode 100644 index 0000000000..5d2097235a --- /dev/null +++ b/modules/aerodyn/tests/aerodyn_utest.F90 @@ -0,0 +1,34 @@ +program aerodyn_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_AD_FVW, only: test_AD_FVW_suite +use NWTC_Num + +implicit none +integer :: stat, is, total_tests +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("FVW", test_AD_FVW_suite) & + ] + +total_tests = 0 +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/aerodyn/tests/test_AD_FVW.F90 b/modules/aerodyn/tests/test_AD_FVW.F90 new file mode 100644 index 0000000000..fb6e233b4f --- /dev/null +++ b/modules/aerodyn/tests/test_AD_FVW.F90 @@ -0,0 +1,62 @@ +module test_AD_FVW + +use testdrive, only: new_unittest, unittest_type, error_type, check +use NWTC_Num +use FVW_Tests + +implicit none + +private +public :: test_AD_FVW_suite + +contains + +!> Collect all exported unit tests +subroutine test_AD_FVW_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_AD_FVW_all", test_AD_FVW_all)] +end subroutine + +subroutine test_AD_FVW_all(error) + type(error_type), allocatable, intent(out) :: error + ! test branches + ! - known valid checks for various FVW routines (contained in own module) + ! - known invalid rotation matrix: halve the angle of the diagonal elements + + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(1024) :: testname + + ! initialize NWTC_Num constants + call SetConstants() + + ! This is a single routine that contains the test cases below. + ! -------------------------------------------------------------------------- + testname = "Set of FVW tests" + call FVW_RunTests(ErrStat, ErrMsg) + call check(error, ErrID_None, ErrStat); if (allocated(error)) return + + ! test routines from FVW_RunTests to be run individually -- except these are all private + ! ! -------------------------------------------------------------------------- + ! testname = "known valid Biot-Savart segment" + ! call Test_BiotSavart_Sgmt(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + ! + ! ! -------------------------------------------------------------------------- + ! testname = "known valid Biot-Savart part" + ! call Test_BiotSavart_Part(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + ! + ! ! -------------------------------------------------------------------------- + ! testname = "known valid Biot-Savart to part-tree" + ! call Test_BiotSavart_PartTree(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + ! + ! ! -------------------------------------------------------------------------- + ! testname = "known valid segment split to parts" + ! call Test_SegmentsToPart(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + +end subroutine + +end module diff --git a/modules/aerodyn/tests/test_FVW_testsuite.F90 b/modules/aerodyn/tests/test_FVW_testsuite.F90 deleted file mode 100644 index 57a72ea24b..0000000000 --- a/modules/aerodyn/tests/test_FVW_testsuite.F90 +++ /dev/null @@ -1,48 +0,0 @@ -@test -subroutine test_AD_FVW() - ! test branches - ! - known valid checks for various FVW routines (contained in own module) - ! - known invalid rotation matrix: halve the angle of the diagonal elements - - use pFUnit_mod - use NWTC_Num - use FVW_Tests - - implicit none - - integer(IntKi) :: ErrStat - character(ErrMsgLen) :: ErrMsg - character(1024) :: testname - - ! initialize NWTC_Num constants - call SetConstants() - -!This is a single routine that contains the test cases below. - ! -------------------------------------------------------------------------- - testname = "Set of FVW tests" - call FVW_RunTests( ErrStat, ErrMsg ) - @assertEqual(0, ErrStat, testname) - - -! test routines from FVW_RunTests to be run individually -- except these are all private -! ! -------------------------------------------------------------------------- -! testname = "known valid Biot-Savart segment" -! call Test_BiotSavart_Sgmt(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) -! -! ! -------------------------------------------------------------------------- -! testname = "known valid Biot-Savart part" -! call Test_BiotSavart_Part(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) -! -! ! -------------------------------------------------------------------------- -! testname = "known valid Biot-Savart to part-tree" -! call Test_BiotSavart_PartTree(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) -! -! ! -------------------------------------------------------------------------- -! testname = "known valid segment split to parts" -! call Test_SegmentsToPart(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) - -end subroutine test_AD_FVW diff --git a/modules/beamdyn/tests/beamdyn_utest.F90 b/modules/beamdyn/tests/beamdyn_utest.F90 new file mode 100644 index 0000000000..f535668ad1 --- /dev/null +++ b/modules/beamdyn/tests/beamdyn_utest.F90 @@ -0,0 +1,48 @@ +program beamdyn_utest + use, intrinsic :: iso_fortran_env, only: error_unit + use testdrive, only: run_testsuite, new_testsuite, testsuite_type + + use test_BD_Crv, only: test_BD_Crv_suite + use test_BD_diffmtc, only: test_BD_diffmtc_suite + use test_BD_InitializeNodalLocations, only: test_BD_InitializeNodalLocations_suite + use test_BD_MemberEta, only: test_BD_MemberEta_suite + use test_BD_Misc, only: test_BD_Misc_suite + use test_BD_QuadraturePointData, only: test_BD_QuadraturePointData_suite + use test_BD_ShapeFuncs, only: test_BD_ShapeFuncs_suite + use test_BD_TrapezoidalPointWeight, only: test_BD_TrapezoidalPointWeight_suite + use NWTC_Num + + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + call SetConstants() + + testsuites = [ & + new_testsuite("Crv", test_BD_Crv_suite), & + new_testsuite("diffmtc", test_BD_diffmtc_suite), & + new_testsuite("InitializeNodalLocations", test_BD_InitializeNodalLocations_suite), & + new_testsuite("MemberEta", test_BD_MemberEta_suite), & + new_testsuite("Misc", test_BD_Misc_suite), & + new_testsuite("QuadraturePointData", test_BD_QuadraturePointData_suite), & + new_testsuite("ShapeFuncs", test_BD_ShapeFuncs_suite), & + new_testsuite("TrapezoidalPointWeight", test_BD_TrapezoidalPointWeight_suite) & + ] + + do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if + + write (error_unit, fmt) "All tests PASSED" + + end program + \ No newline at end of file diff --git a/modules/beamdyn/tests/test_BD_CheckRotMat.F90 b/modules/beamdyn/tests/test_BD_CheckRotMat.F90 deleted file mode 100644 index c1750fd298..0000000000 --- a/modules/beamdyn/tests/test_BD_CheckRotMat.F90 +++ /dev/null @@ -1,44 +0,0 @@ -@test -subroutine test_BD_CheckRotMat() - ! test branches - ! - known valid rotation matrix: pi about x-axis - ! - known invalid rotation matrix: halve the angle of the diagonal elements - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi) :: n(3) - real(BDKi) :: angle - real(BDKi) :: testR(3,3) - integer(IntKi) :: ErrStat - character(ErrMsgLen) :: ErrMsg - character(1024) :: testname - - ! initialize NWTC_Num constants - call SetConstants() - - ! set the rotation axis and angle for all tests - n = (/ 1, 0, 0 /) ! x axis - angle = Pi - - - ! -------------------------------------------------------------------------- - testname = "known valid rotation matrix: pi about x-axis:" - testR = calcRotationMatrix(angle, n) - call BD_CheckRotMat(testR, ErrStat, ErrMsg) - @assertEqual(0, ErrStat, testname) - - - ! -------------------------------------------------------------------------- - testname = "known invalid rotation matrix: halve the angle of the diagonal elements:" - ! this should produce a fatal error (ErrStat = 4) - testR(:,2) = (/ testR(1,2), cos(real(Pi/2, BDKi)), testR(3,2) /) - testR(:,3) = (/ testR(1,2), testR(2,2), cos(real(Pi/2, BDKi)) /) - call BD_CheckRotMat(testR, ErrStat, ErrMsg) - @assertEqual(4, ErrStat, testname) - -end subroutine test_BD_CheckRotMat diff --git a/modules/beamdyn/tests/test_BD_ComputeIniNodalCrv.F90 b/modules/beamdyn/tests/test_BD_ComputeIniNodalCrv.F90 deleted file mode 100644 index a32f7a0b0b..0000000000 --- a/modules/beamdyn/tests/test_BD_ComputeIniNodalCrv.F90 +++ /dev/null @@ -1,83 +0,0 @@ -@test -subroutine test_BD_ComputeIniNodalCrv() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: r - real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams - real(BDKi) :: angle, param, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "Tangent aligned with z-axis and 0 degree twist:" - n = (/ real(0.0, BDKi), real(0.0, BDKi), real(1.0, BDKi) /) ! tangent axis - angle = 0 - - ! Baseline Wiener-Milenkovic parameters - baseline_wmparams = (/ 0.0, 0.0, 0.0 /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - ! -------------------------------------------------------------------------- - testname = "Tangent at 45 degree w.r.t. y-axis and 0 degree twist:" - n = (/ 1.0_BDKi/sqrt(2.0_BDKi), 0.0_BDKi, 1.0_BDKi/sqrt(2.0_BDKi) /) ! tangent axis - angle = 0.0_BDKi - - ! Baseline Wiener-Milenkovic parameters - param = 4*tan((Pi_D/4)/4) - baseline_wmparams = (/ real(0.0, BDKi), param, real(0.0, BDKi) /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - ! -------------------------------------------------------------------------- - testname = "Tangent at -45 degree w.r.t. x-axis and 0 degree twist:" - n = (/ 0.0_BDKi, 1.0_BDKi/sqrt(2.0_BDKi), 1.0_BDKi/sqrt(2.0_BDKi) /) ! tangent axis - angle = 0.0_BDKi - - ! Baseline Wiener-Milenkovic parameters - param = 4.*tan((-Pi_D/4.)/4.) - baseline_wmparams = (/ param, real(0.0, BDKi), real(0.0, BDKi) /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - ! -------------------------------------------------------------------------- - testname = "Tangent along z-axis with 45 degree twist:" - n = (/ real(0.0, BDKi), real(0.0, BDKi), 1.0_BDKi /) ! tangent axis - angle = 45.0_BDKi - - ! Baseline Wiener-Milenkovic parameters - param = 4.*tan((Pi_D/4.)/4.) - baseline_wmparams = (/ real(0.0, BDKi), real(0.0, BDKi), param /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - -end subroutine test_BD_ComputeIniNodalCrv diff --git a/modules/beamdyn/tests/test_BD_Crv.F90 b/modules/beamdyn/tests/test_BD_Crv.F90 new file mode 100644 index 0000000000..1cbd04cbfa --- /dev/null +++ b/modules/beamdyn/tests/test_BD_Crv.F90 @@ -0,0 +1,465 @@ +module test_BD_Crv + +use test_tools +use BeamDyn_Subs + +implicit none + +private +public :: test_BD_Crv_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_Crv_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_CheckRotMat", test_BD_CheckRotMat), & + new_unittest("test_BD_ComputeIniNodalCrv", test_BD_ComputeIniNodalCrv), & + new_unittest("test_BD_CrvCompose", test_BD_CrvCompose), & + new_unittest("test_BD_CrvExtractCrv", test_BD_CrvExtractCrv), & + new_unittest("test_BD_CrvMatrixH", test_BD_CrvMatrixH), & + new_unittest("test_BD_CrvMatrixR", test_BD_CrvMatrixR) & + ] +end subroutine + +subroutine test_BD_CheckRotMat(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - known valid rotation matrix: pi about x-axis + ! - known invalid rotation matrix: halve the angle of the diagonal elements + + real(BDKi) :: n(3) + real(BDKi) :: angle + real(BDKi) :: testR(3, 3) + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(1024) :: testname + + ! set the rotation axis and angle for all tests + n = [1, 0, 0] ! x axis + angle = Pi + + ! -------------------------------------------------------------------------- + testname = "known valid rotation matrix: pi about x-axis:" + testR = calcRotationMatrix(angle, n) + call BD_CheckRotMat(testR, ErrStat, ErrMsg) + call check(error, 0, ErrStat, testname); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "known invalid rotation matrix: halve the angle of the diagonal elements:" + ! this should produce a fatal error (ErrStat = 4) + testR(:, 2) = [testR(1, 2), cos(real(Pi / 2, BDKi)), testR(3, 2)] + testR(:, 3) = [testR(1, 2), testR(2, 2), cos(real(Pi / 2, BDKi))] + call BD_CheckRotMat(testR, ErrStat, ErrMsg) + call check(error, 4, ErrStat, testname); if (allocated(error)) return + +end subroutine + +subroutine test_BD_ComputeIniNodalCrv(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + real(BDKi), dimension(3, 3) :: r + real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams + real(BDKi) :: angle, param, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! -------------------------------------------------------------------------- + testname = "Tangent aligned with z-axis and 0 degree twist:" + n = [real(0.0, BDKi), real(0.0, BDKi), real(1.0, BDKi)] ! tangent axis + angle = 0 + + ! Baseline Wiener-Milenkovic parameters + baseline_wmparams = [0.0, 0.0, 0.0] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "Tangent at 45 degree w.r.t. y-axis and 0 degree twist:" + n = [1.0_BDKi / sqrt(2.0_BDKi), 0.0_BDKi, 1.0_BDKi / sqrt(2.0_BDKi)] ! tangent axis + angle = 0.0_BDKi + + ! Baseline Wiener-Milenkovic parameters + param = 4 * tan((Pi_D / 4) / 4) + baseline_wmparams = [real(0.0, BDKi), param, real(0.0, BDKi)] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "Tangent at -45 degree w.r.t. x-axis and 0 degree twist:" + n = [0.0_BDKi, 1.0_BDKi / sqrt(2.0_BDKi), 1.0_BDKi / sqrt(2.0_BDKi)] ! tangent axis + angle = 0.0_BDKi + + ! Baseline Wiener-Milenkovic parameters + param = 4.*tan((-Pi_D / 4.) / 4.) + baseline_wmparams = [param, real(0.0, BDKi), real(0.0, BDKi)] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "Tangent along z-axis with 45 degree twist:" + n = [real(0.0, BDKi), real(0.0, BDKi), 1.0_BDKi] ! tangent axis + angle = 45.0_BDKi + + ! Baseline Wiener-Milenkovic parameters + param = 4.*tan((Pi_D / 4.) / 4.) + baseline_wmparams = [real(0.0, BDKi), real(0.0, BDKi), param] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_CrvCompose(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - both rotation angles 0, no transpose of input rotations (flag = 0) + ! - delta2 > 0, no transpose of input rotations (flag = 0) + ! - delta2 < 0, no transpose of input rotations (flag = 0) + ! - flag = 1 + ! - flag = 2 + ! - flag = 3 + + ! input rotation axis and angle + real(BDKi), dimension(3) :: n1, n2 + real(BDKi) :: angle1, angle2 + + ! result rotations + real(BDKi), dimension(3, 3) :: testrotation, baselinerotation, r1, r2 + real(BDKi), dimension(3) :: composedparams + + ! other test settings + integer :: flag + character(1024) :: testname + + ! set the rotation axes for all tests + n1 = [1, 0, 0] ! x axis + n2 = [0, 0, 1] ! z axis + + ! -------------------------------------------------------------------------- + testname = "both rotation angles 0, no transpose of input rotations (flag = 0):" + angle1 = 0 ! 0 degrees + angle2 = 0 ! 0 degrees + flag = 0 + + ! both rotations should return an identity matrix + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, no transpose of input rotations (flag = 0):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 0 + + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 < 0, no transpose of input rotations (flag = 0):" + angle1 = PiBy2_D ! 90 degrees + angle2 = 1.5 * Pi ! 270 degrees + flag = 0 + + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, transpose of first rotation (flag = 1):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 1 + + r1 = calcRotationMatrix(-angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, transpose of second rotation (flag = 2):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 2 + + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(-angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, transpose of both rotations (flag = 3):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 3 + + r1 = calcRotationMatrix(-angle1, n1) + r2 = calcRotationMatrix(-angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_CrvExtractCrv(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + real(BDKi), dimension(3, 3) :: r + real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams + real(BDKi) :: angle, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! set the rotation axis for all tests + n = [1, 0, 0] ! x axis + + ! -------------------------------------------------------------------------- + testname = "simple rotation with known parameters: Pi on xaxis:" + angle = Pi_D + + ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> + baseline_wmparams = [4.0, 0.0, 0.0] + + r = RonXAxis(angle) + call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "0 rotation:" + angle = 0 + + ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> + baseline_wmparams = [0.0, 0.0, 0.0] + + r = RonXAxis(angle) + call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "small rotation with baseline WM parameters calculated:" + angle = 0.1 * Pi_D + + ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 + baseline_wmparams = 4 * tan(angle / 4) * n + + r = RonXAxis(angle) + call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_CrvMatrixH(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + ! TODO + ! invalid wm parameters (if thats a thing) + ! does the implemented WM formulation have any boundaries? + + real(BDKi), dimension(3, 3) :: testH, baselineH + real(BDKi), dimension(3) :: wmparams + real(BDKi) :: angle, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! set the rotation axis for all tests + n = [1., 0., 0.] ! x axis + + ! -------------------------------------------------------------------------- + testname = "simple rotation with known parameters: Pi on xaxis:" + angle = Pi_D + + ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> + wmparams = [4.0, 0.0, 0.0] + + baselineH = H(wmparams) + + call BD_CrvMatrixH(wmparams, testH) + + call check_array(error, baselineH, testH, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "0 rotation:" + angle = 0 + + ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> + wmparams = [0.0, 0.0, 0.0] + + baselineH = H(wmparams) + + call BD_CrvMatrixH(wmparams, testH) + + call check_array(error, baselineH, testH, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "small rotation with baseline WM parameters calculated:" + angle = 0.1 * Pi_D + + ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 + wmparams = 4.*tan(angle / 4.) * n + + baselineH = H(wmparams) + + call BD_CrvMatrixH(wmparams, testH) + + call check_array(error, baselineH, testH, testname, tolerance); if (allocated(error)) return + +contains + function H(c) + real(BDKi) :: c0, c(3) + real(BDKi) :: H(3, 3) + + c0 = 2.0 - dot_product(c, c) / 8.0 + + H(1, :) = [c0 + c(1) * c(1) / 4., c(1) * c(2) / 4.-c(3), c(1) * c(3) / 4.+c(2)] + H(2, :) = [c(1) * c(2) / 4.+c(3), c0 + c(2) * c(2) / 4., c(2) * c(3) / 4.-c(1)] + H(3, :) = [c(1) * c(3) / 4.-c(2), c(2) * c(3) / 4.+c(1), c0 + c(3) * c(3) / 4.] + H = 2.*H / (4.-c0)**2 + + end function +end subroutine + +subroutine test_BD_CrvMatrixR(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + ! TODO + ! invalid wm parameters (if thats a thing) + ! does the implemented WM formulation have any boundaries? + + real(BDKi), dimension(3, 3) :: testR, baselineR + real(BDKi), dimension(3) :: wmparams + real(BDKi) :: angle, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! set the rotation axis for all tests + n = [1, 0, 0] ! x axis + + ! -------------------------------------------------------------------------- + testname = "simple rotation with known parameters: Pi on xaxis:" + angle = Pi_D + + baselineR = RonXAxis(angle) + + ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> + wmparams = [4.0, 0.0, 0.0] + call BD_CrvMatrixR(wmparams, testR) + + call check_array(error, baselineR, testR, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "0 rotation:" + angle = 0 + + baselineR = RonXAxis(angle) + + ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> + wmparams = [0.0, 0.0, 0.0] + call BD_CrvMatrixR(wmparams, testR) + + call check_array(error, baselineR, testR, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "small rotation with baseline WM parameters calculated:" + angle = 0.1 * Pi_D + + baselineR = RonXAxis(angle) + + ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 + wmparams = 4 * tan(angle / 4) * n + call BD_CrvMatrixR(wmparams, testR) + + call check_array(error, baselineR, testR, testname, tolerance); if (allocated(error)) return + +end subroutine + +! this is actually an integration test not a unit test... +subroutine test_BD_ExtractRelativeRotation(error) + type(error_type), allocatable, intent(out) :: error + real(BDKi), dimension(3) :: rr + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + type(BD_ParameterType) :: parametertype + type(BD_OtherStateType) :: otherstate + + testname = "static simple beam under gravity:" + otherstate = simpleOtherState() + parametertype = simpleParameterType(1, 16, 16, 0, 0) + call ExtractRelativeRotation(identity(), parametertype, otherstate, rr, ErrStat, ErrMsg) + call check_array(error, rr, [0.0_BDKi, 0.0_BDKi, 0.0_BDKi], testname, tolerance); if (allocated(error)) return +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_CrvCompose.F90 b/modules/beamdyn/tests/test_BD_CrvCompose.F90 deleted file mode 100644 index a376a6af82..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvCompose.F90 +++ /dev/null @@ -1,137 +0,0 @@ -@test -subroutine test_BD_CrvCompose() - ! test branches - ! - both rotation angles 0, no transpose of input rotations (flag = 0) - ! - delta2 > 0, no transpose of input rotations (flag = 0) - ! - delta2 < 0, no transpose of input rotations (flag = 0) - ! - flag = 1 - ! - flag = 2 - ! - flag = 3 - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - ! input rotation axis and angle - real(BDKi), dimension(3) :: n1, n2 - real(BDKi) :: angle1, angle2 - - ! result rotations - real(BDKi), dimension(3,3) :: testrotation, baselinerotation, r1, r2 - real(BDKi), dimension(3) :: composedparams - - ! other test settings - integer :: flag - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axes for all tests - n1 = (/ 1, 0, 0 /) ! x axis - n2 = (/ 0, 0, 1 /) ! z axis - - - ! -------------------------------------------------------------------------- - testname = "both rotation angles 0, no transpose of input rotations (flag = 0):" - angle1 = 0 ! 0 degrees - angle2 = 0 ! 0 degrees - flag = 0 - - ! both rotations should return an identity matrix - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, no transpose of input rotations (flag = 0):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 0 - - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 < 0, no transpose of input rotations (flag = 0):" - angle1 = PiBy2_D ! 90 degrees - angle2 = 1.5*Pi ! 270 degrees - flag = 0 - - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, transpose of first rotation (flag = 1):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 1 - - r1 = calcRotationMatrix(-angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, transpose of second rotation (flag = 2):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 2 - - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(-angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, transpose of both rotations (flag = 3):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 3 - - r1 = calcRotationMatrix(-angle1, n1) - r2 = calcRotationMatrix(-angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_CrvExtractCrv.F90 b/modules/beamdyn/tests/test_BD_CrvExtractCrv.F90 deleted file mode 100644 index bd8143f18b..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvExtractCrv.F90 +++ /dev/null @@ -1,73 +0,0 @@ -@test -subroutine test_BD_CrvExtractCrv() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: r - real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams - real(BDKi) :: angle, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axis for all tests - n = (/ 1, 0, 0 /) ! x axis - - - ! -------------------------------------------------------------------------- - testname = "simple rotation with known parameters: Pi on xaxis:" - angle = Pi_D - - ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> - baseline_wmparams = (/ 4.0, 0.0, 0.0 /) - - r = RonXAxis(angle) - call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "0 rotation:" - angle = 0 - - ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> - baseline_wmparams = (/ 0.0, 0.0, 0.0 /) - - r = RonXAxis(angle) - call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "small rotation with baseline WM parameters calculated:" - angle = 0.1*Pi_D - - ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 - baseline_wmparams = 4*tan(angle/4)*n - - r = RonXAxis(angle) - call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - -end subroutine test_BD_CrvExtractCrv diff --git a/modules/beamdyn/tests/test_BD_CrvMatrixH.F90 b/modules/beamdyn/tests/test_BD_CrvMatrixH.F90 deleted file mode 100644 index b71381de57..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvMatrixH.F90 +++ /dev/null @@ -1,90 +0,0 @@ -@test -subroutine test_BD_CrvMatrixH() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - ! TODO - ! invalid wm parameters (if thats a thing) - ! does the implemented WM formulation have any boundaries? - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: testH, baselineH - real(BDKi), dimension(3) :: wmparams - real(BDKi) :: angle, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axis for all tests - n = (/ 1., 0., 0. /) ! x axis - - - ! -------------------------------------------------------------------------- - testname = "simple rotation with known parameters: Pi on xaxis:" - angle = Pi_D - - ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> - wmparams = (/ 4.0, 0.0, 0.0 /) - - baselineH = H(wmparams) - - call BD_CrvMatrixH(wmparams, testH) - - @assertEqual(baselineH, testH, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "0 rotation:" - angle = 0 - - ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> - wmparams = (/ 0.0, 0.0, 0.0 /) - - baselineH = H(wmparams) - - call BD_CrvMatrixH(wmparams, testH) - - @assertEqual(baselineH, testH, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "small rotation with baseline WM parameters calculated:" - angle = 0.1*Pi_D - - ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 - wmparams = 4.*tan(angle/4.)*n - - baselineH = H(wmparams) - - call BD_CrvMatrixH(wmparams, testH) - - @assertEqual(baselineH, testH, tolerance, testname) - - contains - function H(c) - real(BDKi) :: c0, c(3) - real(BDKi) :: H(3,3) - - c0 = 2.0 - dot_product(c,c) / 8.0 - - H(1,:) = (/ c0 + c(1)*c(1)/4., c(1)*c(2)/4. - c(3), c(1)*c(3)/4. + c(2) /) - H(2,:) = (/ c(1)*c(2)/4. + c(3), c0 + c(2)*c(2)/4., c(2)*c(3)/4. - c(1) /) - H(3,:) = (/ c(1)*c(3)/4. - c(2), c(2)*c(3)/4. + c(1), c0 + c(3)*c(3)/4. /) - H = 2.*H/(4.-c0)**2 - - end function -end subroutine diff --git a/modules/beamdyn/tests/test_BD_CrvMatrixR.F90 b/modules/beamdyn/tests/test_BD_CrvMatrixR.F90 deleted file mode 100644 index b2cf779122..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvMatrixR.F90 +++ /dev/null @@ -1,74 +0,0 @@ -@test -subroutine test_BD_CrvMatrixR() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - ! TODO - ! invalid wm parameters (if thats a thing) - ! does the implemented WM formulation have any boundaries? - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: testR, baselineR - real(BDKi), dimension(3) :: wmparams - real(BDKi) :: angle, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axis for all tests - n = (/ 1, 0, 0 /) ! x axis - - - ! -------------------------------------------------------------------------- - testname = "simple rotation with known parameters: Pi on xaxis:" - angle = Pi_D - - baselineR = RonXAxis(angle) - - ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> - wmparams = (/ 4.0, 0.0, 0.0 /) - call BD_CrvMatrixR(wmparams, testR) - - @assertEqual(baselineR, testR, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "0 rotation:" - angle = 0 - - baselineR = RonXAxis(angle) - - ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> - wmparams = (/ 0.0, 0.0, 0.0 /) - call BD_CrvMatrixR(wmparams, testR) - - @assertEqual(baselineR, testR, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "small rotation with baseline WM parameters calculated:" - angle = 0.1*Pi_D - - baselineR = RonXAxis(angle) - - ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 - wmparams = 4*tan(angle/4)*n - call BD_CrvMatrixR(wmparams, testR) - - @assertEqual(baselineR, testR, tolerance, testname) - -end subroutine test_BD_CrvMatrixR diff --git a/modules/beamdyn/tests/test_BD_DistrLoadCopy.F90 b/modules/beamdyn/tests/test_BD_DistrLoadCopy.F90 deleted file mode 100644 index 64f2970e4c..0000000000 --- a/modules/beamdyn/tests/test_BD_DistrLoadCopy.F90 +++ /dev/null @@ -1,46 +0,0 @@ -@test -subroutine test_BD_DistrLoadCopy() - ! branches to test - ! - the 2D array is correctly stored in the 3D array - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, j - type(BD_ParameterType) :: parametertype - type(BD_InputType) :: inputtype - type(BD_MiscVarType) :: miscvartype - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - - ! build the parametertype, inputtype, and miscvartype - parametertype = simpleParameterType(1,16,16,0,1) - miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) - inputtype = simpleInputType(parametertype%nqp, parametertype%elem_total) - - call BD_DistrLoadCopy(parametertype, inputtype, miscvartype) - - do j = 1, parametertype%elem_total - do i = 1, parametertype%nqp - @assertEqual((/ 9*(j-1)+3*(i-1)+1, 9*(j-1)+3*(i-1)+2, 9*(j-1)+3*(i-1)+3 /), miscvartype%DistrLoad_QP(1:3,i,j)) - @assertEqual((/ -9*(j-1)-3*(i-1)-1, -9*(j-1)-3*(i-1)-2, -9*(j-1)-3*(i-1)-3 /), miscvartype%DistrLoad_QP(4:6,i,j)) - end do - end do - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) -end subroutine diff --git a/modules/beamdyn/tests/test_BD_GaussPointWeight.F90 b/modules/beamdyn/tests/test_BD_GaussPointWeight.F90 deleted file mode 100644 index 9464377b2a..0000000000 --- a/modules/beamdyn/tests/test_BD_GaussPointWeight.F90 +++ /dev/null @@ -1,123 +0,0 @@ -@test -subroutine test_BD_GaussPointWeight() - ! test branches - ! - p = 1, invalid value - ! - p = 2, boundaries only - ! - p = 5, odd number - ! - p = 6, even number - ! - p = 97, large, prime number - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - integer :: p - real(BDKi), allocatable :: locations(:), weights(:) - real(BDKi), allocatable :: baselinelocations(:), baselineweights(:) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-10 - - - ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature - ! the Python Numpy package provides this functionality with numpy.polynomial.legendre.leggauss. - ! the first array returned are locations and the second are the weights - ! >>> from numpy import polynomial - ! >>> polynomial.legendre.leggauss(2) - ! (array([-0.57735027, 0.57735027]), array([ 1., 1.])) - ! >>> polynomial.legendre.leggauss(5) - ! (array([-0.90617985, -0.53846931, 0. , 0.53846931, 0.90617985]), array([ 0.23692689, 0.47862867, 0.56888889, 0.47862867, 0.23692689])) - - - ! -------------------------------------------------------------------------- - testname = "p = 1, invalid value:" - p = 1 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.57735026919, 0.57735026919 /) - baselineweights = (/ 1.0, 1.0/) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(4, ErrStat, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - - - ! -------------------------------------------------------------------------- - testname = "p = 2, boundaries only:" - p = 2 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.57735026919, 0.57735026919 /) - baselineweights = (/ 1.0, 1.0/) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(baselinelocations, locations, tolerance, testname) - @assertEqual(baselineweights, weights, tolerance, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - - - ! -------------------------------------------------------------------------- - testname = "p = 5, odd number:" - p = 5 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.906179845939, -0.538469310106, 0.0, 0.538469310106, 0.906179845939 /) - baselineweights = (/ 0.236926885056, 0.478628670499, 0.568888888889, 0.478628670499, 0.236926885056 /) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(baselinelocations, locations, tolerance, testname) - @assertEqual(baselineweights, weights, tolerance, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - - - ! -------------------------------------------------------------------------- - testname = "p = 6, even number:" - p = 6 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.932469514203, -0.661209386466, -0.238619186083, 0.238619186083, 0.661209386466, 0.932469514203 /) - baselineweights = (/ 0.171324492379, 0.360761573048, 0.467913934573, 0.467913934573, 0.360761573048, 0.171324492379 /) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(baselinelocations, locations, tolerance, testname) - @assertEqual(baselineweights, weights, tolerance, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_GenerateGLL.F90 b/modules/beamdyn/tests/test_BD_GenerateGLL.F90 deleted file mode 100644 index d71e758957..0000000000 --- a/modules/beamdyn/tests/test_BD_GenerateGLL.F90 +++ /dev/null @@ -1,117 +0,0 @@ -@test -subroutine test_BD_GenerateGLL() - ! test branches - ! - p = 2, boundaries only - ! - p = 5, odd number - ! - p = 6, even number - ! - p = 97, large, prime number - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - integer :: p - real(BDKi), allocatable :: gll_nodes(:), baseline(:) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature - ! this website provides the nodes and weights: - ! http://keisan.casio.com/exec/system/1280801905 - - - ! -------------------------------------------------------------------------- - testname = "p = 2, boundaries only:" - p = 2 - allocate(baseline(p)) - baseline = (/ -1.0, 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - - ! -------------------------------------------------------------------------- - testname = "p = 5, odd number:" - p = 5 - allocate(baseline(p)) - baseline = (/ -1.0, -0.6546536707079771437983, 0.0, 0.654653670707977143798, 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - - - ! -------------------------------------------------------------------------- - testname = "p = 6, even number:" - p = 6 - allocate(baseline(p)) - baseline = (/ -1.0, -0.765055323929464692851, -0.2852315164806450963142, 0.2852315164806450963142, 0.765055323929464692851, 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - - - ! -------------------------------------------------------------------------- - testname = "p = 97, large, prime number:" - p = 97 - allocate(baseline(p)) - baseline = (/ & - -1.0, -0.9992117675187679372925, -0.997358420211575308381, -0.994447829238317218534, & - -0.9904833045655763827779, -0.9854690874505481580336, -0.9794105031099910659294, -0.972313976393383949863, & - -0.964187029755659609253, -0.955038276712134050045, -0.944877413224633009627, -0.933715207638498109806, & - -0.921563489367936527388, -0.9084351364079280548151, -0.8943440617122115723236, -0.8793051984632038831786,& - -0.8633344842547974738284, -0.8464488442074511804343, -0.8286661730348553921423, -0.810005316081936147328, & - -0.7904860493547251817926, -0.7701290585635136140501, -0.748955917201652598455, -0.7269890636833281333, & - -0.704251777564599720681, -0.6807681548729427782946, -0.6565630825714660926978, -0.631662212184884059709, & - -0.6060919326152061877601, -0.579879342175961313997, -0.553052219874599625586, -0.5256389959735105979894,& - -0.4976687218608582506373, -0.4691710392631656985371, -0.440176148832277959663, -0.4107147781399945491769,& - -0.3808181491142908001982, -0.350517944951638397684, -0.3198462765404906463777, -0.2888356484315159109028,& - -0.257518924390642905356, -0.2259292925714235538959, -0.1941002303436225183436, -0.1620654688153067619161,& - -0.1298589570860333006308, -0.09751482626901823919031, -0.0650673533204149925476, -0.032550924714033997197, & - 0.0, 0.032550924714033997197, 0.0650673533204149925476, 0.0975148262690182391903,& - 0.1298589570860333006308, 0.1620654688153067619161, 0.194100230343622518344, 0.225929292571423553896, & - 0.257518924390642905356, 0.2888356484315159109028, 0.3198462765404906463777, 0.3505179449516383976839,& - 0.3808181491142908001982, 0.410714778139994549177, 0.4401761488322779596629, 0.4691710392631656985371,& - 0.4976687218608582506373, 0.5256389959735105979894, 0.5530522198745996255862, 0.579879342175961313997, & - 0.6060919326152061877601, 0.6316622121848840597089, 0.6565630825714660926978, 0.6807681548729427782946,& - 0.7042517775645997206813, 0.7269890636833281332999, 0.7489559172016525984547, 0.7701290585635136140501,& - 0.7904860493547251817926, 0.8100053160819361473279, 0.8286661730348553921423, 0.8464488442074511804343,& - 0.8633344842547974738284, 0.8793051984632038831786, 0.8943440617122115723236, 0.9084351364079280548151,& - 0.9215634893679365273879, 0.933715207638498109806, 0.9448774132246330096275, 0.955038276712134050045, & - 0.9641870297556596092534, 0.9723139763933839498625, 0.9794105031099910659294, 0.9854690874505481580336,& - 0.9904833045655763827779, 0.9944478292383172185338, 0.9973584202115753083808, 0.9992117675187679372925,& - 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_GravityForce.F90 b/modules/beamdyn/tests/test_BD_GravityForce.F90 deleted file mode 100644 index 8b5aef8fcf..0000000000 --- a/modules/beamdyn/tests/test_BD_GravityForce.F90 +++ /dev/null @@ -1,46 +0,0 @@ -@test -subroutine test_BD_GravityForce() - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, j - real(BDKi) :: gravity(3) - type(BD_ParameterType) :: parametertype - type(BD_MiscVarType) :: miscvartype - real(BDKi) :: baseline(6) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - baseline(1:3) = getGravityInZ() - baseline(4:6) = (/ 0.0, 0.0, 0.0 /) - - ! allocate and build the custom types - parametertype = simpleParameterType(1,16,16,0,1) - miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) - - gravity = getGravityInZ() - - ! call the subroutine to test - call BD_GravityForce(1, parametertype, miscvartype, gravity) - - ! test the values - @assertEqual(baseline, miscvartype%qp%Fg(:,1,1), tolerance, testname) - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_InitShpDerJaco.F90 b/modules/beamdyn/tests/test_BD_InitShpDerJaco.F90 deleted file mode 100644 index 13e39f733b..0000000000 --- a/modules/beamdyn/tests/test_BD_InitShpDerJaco.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module test_BD_InitShpDerJaco - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer(IntKi) :: i, j, idx_qp, nelem - type(BD_ParameterType) :: p - real(BDKi), allocatable :: gll_nodes(:), inp_QPtWeight(:) - real(BDKi), allocatable :: baseline_QPtWeight(:), baseline_QPtN(:) - real(BDKi), allocatable :: baseline_Shp(:,:), baseline_ShpDer(:,:), baseline_jacobian(:,:), baseline_QPtw_ShpDer(:,:) - real(BDKi), allocatable :: baseline_QPtw_Shp_ShpDer(:,:,:), baseline_QPtw_Shp_Jac(:,:,:) - real(BDKi), allocatable :: baseline_QPtw_Shp_Shp_Jac(:,:,:,:), baseline_QPtw_ShpDer_ShpDer_Jac(:,:,:,:) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - -contains - - @test - subroutine test_BD_InitShpDerJaco_5node() - ! branches to test - ! - 5 node, 1 element; undeformed - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-13 - - ! -------------------------------------------------------------------------- - testname = "5 node, 1 element, curved:" - - ! Let's use Gauss_Legendre Quadrature, which should be exact for intended polynomial test case - p = simpleparametertype(1,5,5,0,1) - - ! Allocate memory for baseline results - call AllocAry(baseline_Shp , p%nodes_per_elem, p%nqp, 'Reference Shp' , ErrStat, ErrMsg) - call AllocAry(baseline_ShpDer , p%nodes_per_elem, p%nqp, 'Reference ShpDer' , ErrStat, ErrMsg) - call AllocAry(baseline_Jacobian , p%nqp, p%elem_total, 'Reference Jacobian', ErrStat, ErrMsg) - call AllocAry(baseline_QPtN , p%nqp, 'Reference QPtN' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtWeight, p%nqp, 'Reference QPtWeight', ErrStat, ErrMsg) - - ! Allocate memory for other relevant variables belonging to module p - call AllocAry(baseline_QPtw_Shp_Shp_Jac , p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference QPtw_Shp_Shp_Jac' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference baseline_QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_Shp_ShpDer , p%nqp, p%nodes_per_elem, p%nodes_per_elem , 'reference QPtw_Shp_ShpDer' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_Shp_Jac , p%nqp, p%nodes_per_elem, p%elem_total , 'reference QPtw_Shp_Jac' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_ShpDer , p%nqp, p%nodes_per_elem , 'reference QPtw_ShpDer' , ErrStat, ErrMsg) - - ! assign baseline results - ! baseline quadrature points and weights; this is 5-point Gauss-Legendre quadrature - - baseline_QPtN(1:p%nqp) = (/ -0.9061798459386640, -0.5384693101056831, 0. , 0.5384693101056831, 0.9061798459386640 /) - baseline_QPtWeight(1:p%nqp) = (/ 0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891 /) - - ! assign baseline jacobian based; these values were calculated in separte mathematica script - baseline_jacobian(1:p%nqp,1) = (/ 0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582 /) - - ! assign baseline shape functions based on example as described above - baseline_Shp(1,1:p%nqp) = (/ 0.5933706960199465, -0.10048256880508302, 0., 0.030144110771879763, -0.029205077492916114 /) - baseline_Shp(2,1:p%nqp) = (/ 0.516435198649618, 0.9313661019373962, 0., -0.09069490469997694, 0.08322282221996001 /) - baseline_Shp(3,1:p%nqp) = (/ -0.16382363939660807, 0.22966726079578503, 1., 0.22966726079578503, -0.16382363939660807 /) - baseline_Shp(4,1:p%nqp) = (/ 0.08322282221996001, -0.09069490469997694, 0., 0.9313661019373962, 0.516435198649618 /) - baseline_Shp(5,1:p%nqp) = (/ -0.029205077492916114, 0.030144110771879763, 0., -0.10048256880508302, 0.5933706960199465 /) - - ! assign baseline shape function derivatives based on example as described above - baseline_ShpDer(1,1:p%nqp) = (/ -3.705336453591454, -0.5287152679802739, 0.375, -0.24351802112960028, 0.14423640936799356 /) - baseline_ShpDer(2,1:p%nqp) = (/ 4.33282116876393, -1.0976579678283382, -1.3365845776954537, 0.7497385700132875, -0.42067623042767965 /) - baseline_ShpDer(3,1:p%nqp) = (/ -0.9039245362321631, 2.1325937846922898, 0., -2.1325937846922898, 0.9039245362321631 /) - baseline_ShpDer(4,1:p%nqp) = (/ 0.42067623042767965, -0.7497385700132875, 1.3365845776954537, 1.0976579678283382, -4.33282116876393 /) - baseline_ShpDer(5,1:p%nqp) = (/ -0.14423640936799356, 0.24351802112960028, -0.375, 0.5287152679802739, 3.705336453591454 /) - - ! uuN0 is of dimension (3 dof, nodes_per_elem, elem_total) - p%uuN0(1:3,1,1) = (/ 0.0, 0.0, 0.0 /) - p%uuN0(1:3,2,1) = (/ 0.16237631096713473, 0.17578464768961147, 0.1481911137890286 /) - p%uuN0(1:3,3,1) = (/ 0.25, 1., 1.1875 /) - p%uuN0(1:3,4,1) = (/ -0.30523345382427747, 2.4670724951675314, 2.953849702537502 /) - p%uuN0(1:3,5,1) = (/ -1., 3.5, 4. /) - - ! Using BD_GaussPointWeight; hoping it's tested! - call BD_GaussPointWeight(p%nqp, p%QPtN, p%QPtWeight, ErrStat, ErrMsg) - - @assertEqual(baseline_QPtN, p%QPtN , tolerance, testname) - @assertEqual(baseline_QPtWeight, p%QPtWeight, tolerance, testname) - - ! Allocate memory for GLL node positions in 1D parametric space - call AllocAry(gll_nodes, p%nodes_per_elem, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. /) - - ! call the test subroutine - call BD_InitShpDerJaco(gll_nodes, p) - - ! check the baseline shape functions and their derivatives - do idx_qp = 1, p%nqp - do j = 1, p%nodes_per_elem - @assertEqual(baseline_Shp(j,idx_qp) , p%Shp(j,idx_qp) , tolerance, testname) - @assertEqual(baseline_ShpDer(j,idx_qp), p%ShpDer(j,idx_qp), tolerance, testname) - end do - end do - - ! check the baseline jacobian - do nelem = 1, p%elem_total - do idx_qp = 1, p%nqp - @assertEqual(baseline_jacobian(idx_qp,nelem), p%jacobian(idx_qp,nelem), tolerance, testname) - end do - end do - - ! Test and assemble variables N*N^T*wt*Jacobian and dN*dN^T*wt/Jacobian - do nelem = 1, p%elem_total - do idx_qp = 1, p%nqp - do j = 1, p%nodes_per_elem - do i = 1, p%nodes_per_elem - ! Check the variable N*N^T*Jacobian - baseline_QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = baseline_Shp(i,idx_qp)*baseline_Shp(j,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_jacobian(idx_qp,nelem) - @assertEqual(baseline_QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem), p%QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem), tolerance, testname) - - ! Check the variable dN*dN^T*Jacobian - baseline_QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = baseline_ShpDer(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp)/baseline_jacobian(idx_qp,nelem) - @assertEqual(baseline_QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem), p%QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem), tolerance, testname) - end do - end do - end do - end do - - ! Test and assemble variable N*dN^T*wt*Jacobian - do idx_qp = 1, p%nqp - do j = 1, p%nodes_per_elem - do i = 1, p%nodes_per_elem - baseline_QPtw_Shp_ShpDer(idx_qp,i,j) = baseline_Shp(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp) - @assertEqual(baseline_QPtw_Shp_ShpDer(idx_qp,i,j), p%QPtw_Shp_ShpDer(idx_qp,i,j), tolerance, testname) - end do - end do - end do - - ! Test and assemble variable N*wt*Jacobian - do nelem = 1, p%elem_total - do i = 1, p%nodes_per_elem - do idx_qp = 1, p%nqp - baseline_QPtw_Shp_Jac(idx_qp,i,nelem) = baseline_Shp(i,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_Jacobian(idx_qp,nelem) - @assertEqual(baseline_QPtw_Shp_Jac(idx_qp,i,nelem), p%QPtw_Shp_Jac(idx_qp,i,nelem), tolerance, testname) - end do - end do - end do - - ! Test and assemble variable dN*wt. - do i = 1, p%nodes_per_elem - do idx_qp = 1, p%nqp - baseline_QPtw_ShpDer(idx_qp,i) = baseline_ShpDer(i,idx_qp)*baseline_QPtWeight(idx_qp) - @assertEqual(baseline_QPtw_ShpDer(idx_qp,i), p%QPtw_ShpDer(idx_qp,i), tolerance, testname) - end do - end do - - ! dealocate baseline variables - if (allocated(gll_nodes)) deallocate(gll_nodes) - deallocate(baseline_Shp) - deallocate(baseline_ShpDer) - deallocate(baseline_Jacobian) - deallocate(baseline_QPtN) - deallocate(baseline_QPtWeight) - deallocate(baseline_QPtw_Shp_Shp_Jac) - deallocate(baseline_QPtw_ShpDer_ShpDer_Jac) - deallocate(baseline_QPtw_Shp_ShpDer) - deallocate(baseline_QPtw_Shp_Jac) - deallocate(baseline_QPtw_ShpDer) - - call BD_DestroyParam(p, ErrStat, ErrMsg) - - end subroutine -end module diff --git a/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 b/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 new file mode 100644 index 0000000000..c23b0ae189 --- /dev/null +++ b/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 @@ -0,0 +1,131 @@ +module test_BD_InitializeNodalLocations + + use test_tools +use BeamDyn + +implicit none + +private +public :: test_BD_InitializeNodalLocations_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_InitializeNodalLocations_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_InitializeNodalLocations_np5_p6", test_BD_InitializeNodalLocations_np5_p6) & + ] +end subroutine + +subroutine test_BD_InitializeNodalLocations_np5_p6(error) + type(error_type), allocatable, intent(out) :: error + + ! test problem where reference line is defined by 1 member, 5 keypoints, + ! and we fit a 6th order LSFE + + type(BD_ParameterType) :: p + + integer(IntKi) :: i ! do loop + + integer(IntKi) :: member_total + integer(IntKi), allocatable :: kp_member(:) + real(BDKi), allocatable :: kp_coordinate(:, :) + + real(BDKi), allocatable :: baseline_uuN0(:, :, :) + real(BDKi), allocatable :: baseline_tangent(:, :, :) + real(BDKi), allocatable :: baseline_twist(:, :) + real(BDKi), allocatable :: gll(:) + + real(BDKi) :: cc(3) + + integer(IntKi) :: np ! number of points defining reference line + + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-13 + + ! -------------------------------------------------------------------------- + testname = "test_InitializeNodalLocations_1m_kp5_p6" + + member_total = 1 + + np = 5 ! five points defining the reference line + p = simpleParameterType(1, 7, 3, 0, 1) !simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) + + p%dof_node = 6 + + call AllocAry(kp_member, member_total, "kp_member", ErrStat, ErrMsg) + call AllocAry(gll, p%nodes_per_elem, "gll", ErrStat, ErrMsg) + call AllocAry(baseline_uuN0, p%dof_node, p%nodes_per_elem, p%elem_total, "baseline_uuN0", ErrStat, ErrMsg) + + call AllocAry(baseline_tangent, 3, p%nodes_per_elem, p%elem_total, "baseline_tangent", ErrStat, ErrMsg) + call AllocAry(baseline_twist, p%nodes_per_elem, p%elem_total, "baseline_twist", ErrStat, ErrMsg) + + ! remove the following once the routine moves to least squares + + call AllocAry(p%segment_eta, np - 1, 'segment length ratio array', ErrStat, ErrMsg) + + kp_member(1) = np ! one member defined by 5 points + + call AllocAry(kp_coordinate, kp_member(1), 4, "kp_coordinate", ErrStat, ErrMsg) + + kp_coordinate(1, :) = [0., 0., 0., 0.] + kp_coordinate(2, :) = [0.2421875, 0.3125, 1.25, 5.625] + kp_coordinate(3, :) = [0.375, 1., 2.5, 22.5] + kp_coordinate(4, :) = [0.1171875, 2.0625, 3.75, 50.625] + kp_coordinate(5, :) = [-1., 3.5, 5., 90.] + + gll(:) = [-1., -0.8302238962785669, -0.46884879347071423, 0., 0.46884879347071423, 0.8302238962785669, 1.] + + baseline_uuN0 = 0. + + ! following calculated in mathematica + baseline_uuN0(1:3, 1, 1) = [0., 0., 0.] + baseline_uuN0(1:3, 2, 1) = [0.0847841995263206, 0.06406196997648083, 0.4244402593035813] + baseline_uuN0(1:3, 3, 1) = [0.2556265283202704, 0.3443790047804582, 1.327878016323214] + baseline_uuN0(1:3, 4, 1) = [0.375, 1., 2.5] + baseline_uuN0(1:3, 5, 1) = [0.152564565773068, 1.985349781927959, 3.672121983676785] + baseline_uuN0(1:3, 6, 1) = [-0.4874656517463806, 2.969845606951464, 4.575559740696413] + baseline_uuN0(1:3, 7, 1) = [-1., 3.5, 5.] + + baseline_tangent(1:3, 1, 1) = [0.1951800145897074, 0.0975900072948519, 0.975900072948533] + baseline_tangent(1:3, 2, 1) = [0.1914764728687931, 0.1942130285347349, 0.962090463462295] + baseline_tangent(1:3, 3, 1) = [0.1549438849532919, 0.3815415434641369, 0.911272979477931] + baseline_tangent(1:3, 4, 1) = [0., 0.5734623443633284, 0.81923192051904] + baseline_tangent(1:3, 5, 1) = [-0.2957782328585355, 0.6690666276575518, 0.6818101529913093] + baseline_tangent(1:3, 6, 1) = [-0.5494018213496115, 0.6414840856724742, 0.535402471535834] + baseline_tangent(1:3, 7, 1) = [-0.6492344540642337, 0.6028605644882184, 0.4637388957601716] + + baseline_twist(1, 1) = 0. + baseline_twist(2, 1) = 0.6485383213836768 + baseline_twist(3, 1) = 6.347736094444107 + baseline_twist(4, 1) = 22.50000000000001 + baseline_twist(5, 1) = 48.54412750680838 + baseline_twist(6, 1) = 75.36868898645466 + baseline_twist(7, 1) = 90. + + ! here we're using the BD_ComputeIniNodalCrv to construct the rotation parameters; this is what is used in + ! BeamDyn; I do not want to rely on this routine and would rather calculate externally + do i = 1, 7 + call BD_ComputeIniNodalCrv(baseline_tangent(1:3, i, 1), baseline_twist(i, 1), cc, ErrStat, ErrMsg) + baseline_uuN0(4:6, i, 1) = cc + end do + + ! remove after reworking fit; dropping spline in favor of lease squares; p%SP_Coef is required in original spline fit implementation + !call ComputeSplineCoeffs(member_total, np, kp_member, kp_coordinate, p%SP_Coef, ErrStat, ErrMsg) + + call InitializeNodalLocations(member_total, kp_member, kp_coordinate, p, GLL, ErrStat, ErrMsg) + + !do i = 1, 7 + ! write(*,*) i, baseline_uuN0(4,i,1), baseline_uuN0(5,i,1), baseline_uuN0(6,i,1), p%uuN0(4,i,1), p%uuN0(5,i,1), p%uuN0(6,i,1) + !enddo + + call check_array(error, baseline_uuN0, p%uuN0, testname, tolerance); if (allocated(error)) return + + call BD_DestroyParam(p, ErrStat, ErrMsg) + +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 b/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 deleted file mode 100644 index 94e56e330f..0000000000 --- a/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 +++ /dev/null @@ -1,104 +0,0 @@ -@test -subroutine test_BD_InputGlobalLocal() - ! branches to test - ! - a simple rotation does the rotation - - ! Check the following quanities are actually rotated - !! 1 Displacements -> u%RootMotion%TranslationDisp(:,1) - !! 2 Linear/Angular velocities -> u%RootMotion%TranslationVel(:,1), u%RootMotion%RotationVel(:,1) - !! 3 Linear/Angular accelerations -> u%RootMotion%TranslationAcc(:,1), u%RootMotion%RotationAcc(:,1) - !! 4 Point forces/moments -> u%PointLoad%Force(1:3,i), u%PointLoad%Moment(1:3,i) - !! 5 Distributed forces/moments -> u%DistrLoad%Force(1:3,i), u%DistrLoad%Moment(1:3,i) - - ! Verify the DCM is transposed - !! u%RootMotion%Orientation(:,:,1) - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, totalnodes - type(BD_ParameterType) :: parametertype - type(BD_OtherStateType) :: otherstate - type(BD_InputType) :: inputtype - real(BDKi), dimension(3) :: vectorInit, vectorAfterRotation, rotationaxis - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - - ! -------------------------------------------------------------------------- - testname = "test_BD_InputGlobalLocal:" - - tolerance = 1e-14 - totalnodes = 2 - vectorInit = (/ 0.0, 0.0, 1.0 /) - vectorAfterRotation = (/ 0.0, 0.0, -1.0 /) - rotationaxis = (/ 1.0, 0.0, 0.0 /) - - ! build the parameter type - parametertype%node_total = totalnodes - otherstate=simpleOtherState() - otherstate%GlbRot = calcRotationMatrix(real(Pi, BDKi), rotationaxis) - - ! build the inputs - call AllocAry(inputtype%RootMotion%TranslationDisp, 3, 1, 'TranslationDisp', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%TranslationVel, 3, 1, 'TranslationVel', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%RotationVel, 3, 1, 'RotationVel', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%TranslationAcc, 3, 1, 'TranslationAcc', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%RotationAcc, 3, 1, 'RotationAcc', ErrStat, ErrMsg) - inputtype%RootMotion%TranslationDisp(:,1) = vectorInit - inputtype%RootMotion%TranslationVel(:,1) = vectorInit - inputtype%RootMotion%RotationVel(:,1) = vectorInit - inputtype%RootMotion%TranslationAcc(:,1) = vectorInit - inputtype%RootMotion%RotationAcc(:,1) = vectorInit - - call AllocAry(inputtype%PointLoad%Force, 3, totalnodes, 'PointLoad%Force', ErrStat, ErrMsg) - call AllocAry(inputtype%PointLoad%Moment, 3, totalnodes, 'PointLoad%Moment', ErrStat, ErrMsg) - do i = 1, parametertype%node_total - inputtype%PointLoad%Force(1:3,i) = vectorInit - inputtype%PointLoad%Moment(1:3,i) = vectorInit - end do - - inputtype%DistrLoad%Nnodes = totalnodes - call AllocAry(inputtype%DistrLoad%Force, 3, totalnodes, 'DistrLoad%Force', ErrStat, ErrMsg) - call AllocAry(inputtype%DistrLoad%Moment, 3, totalnodes, 'DistrLoad%Moment', ErrStat, ErrMsg) - do i = 1, inputtype%DistrLoad%Nnodes - inputtype%DistrLoad%Force(1:3,i) = vectorInit - inputtype%DistrLoad%Moment(1:3,i) = vectorInit - end do - - call AllocAry(inputtype%RootMotion%Orientation, 3, 3, totalnodes, 'RootMotion%Orientation', ErrStat, ErrMsg) - inputtype%RootMotion%Orientation(:,:,1) = otherstate%GlbRot - - ! call the subroutine to test - call BD_InputGlobalLocal(parametertype, otherstate, inputtype) - - ! test the values - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationDisp(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationVel(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%RotationVel(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationAcc(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%RotationAcc(:,1), BDKi), tolerance, testname) - - do i = 1, parametertype%node_total - @assertEqual(vectorAfterRotation, real(inputtype%PointLoad%Force(1:3,i), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%PointLoad%Moment(1:3,i), BDKi), tolerance, testname) - end do - - inputtype%DistrLoad%Nnodes = totalnodes - do i = 1, inputtype%DistrLoad%Nnodes - @assertEqual(vectorAfterRotation, real(inputtype%DistrLoad%Force(1:3,i), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%DistrLoad%Moment(1:3,i), BDKi), tolerance, testname) - end do - - @assertEqual(transpose(otherstate%GlbRot), inputtype%RootMotion%Orientation(:,:,1), tolerance, testname) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_MemberEta.F90 b/modules/beamdyn/tests/test_BD_MemberEta.F90 index 08df56dbfd..208dc94001 100644 --- a/modules/beamdyn/tests/test_BD_MemberEta.F90 +++ b/modules/beamdyn/tests/test_BD_MemberEta.F90 @@ -1,87 +1,90 @@ module test_BD_MemberEta - - ! tests routine that calculates the length of the beam's reference line - ! also finds element boundaries in eta coordinates - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer(IntKi) :: nqp - integer(IntKi) :: member_total - real(BDKi) :: total_length - real(BDKi), allocatable :: baseline_jac(:,:) - real(BDKi), allocatable :: baseline_QPtW(:) - real(BDKi), allocatable :: baseline_member_eta(:) - real(BDKi), allocatable :: test_member_eta(:) - real(BDKi) :: baseline_total_length - real(BDKi) :: test_total_length - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance + +! tests routine that calculates the length of the beam's reference line +! also finds element boundaries in eta coordinates + +use BeamDyn +use NWTC_Num +use test_tools + +implicit none + +private +public :: test_BD_MemberEta_suite contains - @test - subroutine test_BD_MemberEta_5node() - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "test_bd_member_eta_5node" - - ! this test problem is for a beam reference axis defined by 5 points - ! x = 0., 0.16237631096713473, 0.25, -0.30523345382427747, -1. - ! y = 0., 0.17578464768961147, 1., 2.4670724951675314, 3.5 - ! z = 0., 0.1481911137890286, 1.1875, 2.953849702537502, 4. - ! where the underlying forth-order polynomial is - ! fx[u_] = u - 2 u^3; - ! fy[u_] = u/2 + 3 u^2; - ! fz[u_] = 5 u^2 - u^4; - ! - ! exact (to mp) length is 5.627175237247959 - ! The Jacobian values below are calculate based on a 5-node Legendre Spectral Element - ! While we give baseline Jacobian here, we check "test_BD_InitShpDerJaco.F90" elsewhere - - nqp = 5 ! number of quadrature points - member_total = 1 ! 1 element - - call AllocAry(baseline_jac , nqp, member_total, 'Reference Jacobian', ErrStat, ErrMsg) - call AllocAry(baseline_QPtW, nqp, 'Reference QPtWeight', ErrStat, ErrMsg) - call AllocAry(baseline_member_eta, member_total, 'Reference member_eta', ErrStat, ErrMsg) - call AllocAry(test_member_eta, member_total, 'test member_eta', ErrStat, ErrMsg) - - ! 5-point Guass-Legendre quadrature; see https://pomax.github.io/bezierinfo/legendre-gauss.html - baseline_QPtW(1:nqp) = (/ 0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891 /) - - ! assign baseline jacobian based; these values were calculated in separate mathematica script - baseline_jac(1:nqp,1) = (/ 0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582 /) - - ! total length of beam calculated in mathematica; note that for this curved beam, GL quadrature is APPROXIMATE, but - ! converged rapidly; TR quadrature is not nearly as good; commented-out values are useful for understanding quadrature performance - ! for curved beams. - !baseline_total_length = 5.627175237247959 ! this is actual length based on mathematica - !baseline_total_length = 5.634413547964786 ! this is approximation with 9-point Trapezoidal quadrature; 0.13% error - !baseline_total_length = 5.627202424388781 ! this is approximation with 7-point gauss quadrature; 0.0005% error - baseline_total_length = 5.626918236484061 ! this is approximation with 5-point gauss quadrature; 0.005% error (tested here) - baseline_member_eta(1) = 1. ! just one element; so member_length / total_length = 1 - - call BD_MemberEta(member_total, baseline_QPtW, baseline_jac, test_member_eta, test_total_length) - - @assertEqual(baseline_total_length, test_total_length, tolerance, testname) - @assertEqual(baseline_member_eta, test_member_eta, tolerance, testname) - - deallocate(baseline_Jac) - deallocate(baseline_QPtW) - deallocate(baseline_member_eta) - deallocate(test_member_eta) - - end subroutine +!> Collect all exported unit tests +subroutine test_BD_MemberEta_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_MemberEta_5node", test_BD_MemberEta_5node) & + ] + end subroutine + +subroutine test_BD_MemberEta_5node(error) + type(error_type), allocatable, intent(out) :: error + integer(IntKi) :: nqp + integer(IntKi) :: member_total + real(BDKi) :: total_length + real(BDKi), allocatable :: baseline_jac(:, :) + real(BDKi), allocatable :: baseline_QPtW(:) + real(BDKi), allocatable :: baseline_member_eta(:) + real(BDKi), allocatable :: test_member_eta(:) + real(BDKi) :: baseline_total_length + real(BDKi) :: test_total_length + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "test_bd_member_eta_5node" + + ! this test problem is for a beam reference axis defined by 5 points + ! x = 0., 0.16237631096713473, 0.25, -0.30523345382427747, -1. + ! y = 0., 0.17578464768961147, 1., 2.4670724951675314, 3.5 + ! z = 0., 0.1481911137890286, 1.1875, 2.953849702537502, 4. + ! where the underlying forth-order polynomial is + ! fx[u_] = u - 2 u^3; + ! fy[u_] = u/2 + 3 u^2; + ! fz[u_] = 5 u^2 - u^4; + ! + ! exact (to mp) length is 5.627175237247959 + ! The Jacobian values below are calculate based on a 5-node Legendre Spectral Element + ! While we give baseline Jacobian here, we check "test_BD_InitShpDerJaco.F90" elsewhere + + nqp = 5 ! number of quadrature points + member_total = 1 ! 1 element + + call AllocAry(baseline_jac, nqp, member_total, 'Reference Jacobian', ErrStat, ErrMsg) + call AllocAry(baseline_QPtW, nqp, 'Reference QPtWeight', ErrStat, ErrMsg) + call AllocAry(baseline_member_eta, member_total, 'Reference member_eta', ErrStat, ErrMsg) + call AllocAry(test_member_eta, member_total, 'test member_eta', ErrStat, ErrMsg) + + ! 5-point Guass-Legendre quadrature; see https://pomax.github.io/bezierinfo/legendre-gauss.html + baseline_QPtW(1:nqp) = [0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891] + + ! assign baseline jacobian based; these values were calculated in separate mathematica script + baseline_jac(1:nqp, 1) = [0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582] + + ! total length of beam calculated in mathematica; note that for this curved beam, GL quadrature is APPROXIMATE, but + ! converged rapidly; TR quadrature is not nearly as good; commented-out values are useful for understanding quadrature performance + ! for curved beams. + !baseline_total_length = 5.627175237247959 ! this is actual length based on mathematica + !baseline_total_length = 5.634413547964786 ! this is approximation with 9-point Trapezoidal quadrature; 0.13% error + !baseline_total_length = 5.627202424388781 ! this is approximation with 7-point gauss quadrature; 0.0005% error + baseline_total_length = 5.626918236484061 ! this is approximation with 5-point gauss quadrature; 0.005% error (tested here) + baseline_member_eta(1) = 1. ! just one element; so member_length / total_length = 1 + + call BD_MemberEta(member_total, baseline_QPtW, baseline_jac, test_member_eta, test_total_length) + + call check(error, baseline_total_length, test_total_length, testname, thr=tolerance); if (allocated(error)) return + call check_array(error, baseline_member_eta, test_member_eta, testname, tolerance); if (allocated(error)) return + + deallocate (baseline_Jac) + deallocate (baseline_QPtW) + deallocate (baseline_member_eta) + deallocate (test_member_eta) + +end subroutine end module diff --git a/modules/beamdyn/tests/test_BD_Misc.F90 b/modules/beamdyn/tests/test_BD_Misc.F90 new file mode 100644 index 0000000000..ac6b5b38f4 --- /dev/null +++ b/modules/beamdyn/tests/test_BD_Misc.F90 @@ -0,0 +1,219 @@ +module test_BD_Misc + +use test_tools +use BeamDyn_Subs +use BeamDyn + +implicit none + +private +public :: test_BD_Misc_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_Misc_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_DistrLoadCopy", test_BD_DistrLoadCopy), & + new_unittest("test_BD_InputGlobalLocal", test_BD_InputGlobalLocal), & + new_unittest("test_BD_GravityForce", test_BD_GravityForce), & + new_unittest("test_BD_QPData_mEta_rho", test_BD_QPData_mEta_rho) & + ] +end subroutine + +subroutine test_BD_DistrLoadCopy(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - the 2D array is correctly stored in the 3D array + + integer :: i, j + type(BD_ParameterType) :: parametertype + type(BD_InputType) :: inputtype + type(BD_MiscVarType) :: miscvartype + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "static simple beam under gravity:" + + ! build the parametertype, inputtype, and miscvartype + parametertype = simpleParameterType(1, 16, 16, 0, 1) + miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) + inputtype = simpleInputType(parametertype%nqp, parametertype%elem_total) + + call BD_DistrLoadCopy(parametertype, inputtype, miscvartype) + + do j = 1, parametertype%elem_total + do i = 1, parametertype%nqp + call check_array(error, real([9 * (j - 1) + 3 * (i - 1) + 1, 9 * (j - 1) + 3 * (i - 1) + 2, 9 * (j - 1) + 3 * (i - 1) + 3], R8Ki), miscvartype%DistrLoad_QP(1:3, i, j)); if (allocated(error)) return + call check_array(error, real([-9 * (j - 1) - 3 * (i - 1) - 1, -9 * (j - 1) - 3 * (i - 1) - 2, -9 * (j - 1) - 3 * (i - 1) - 3], R8Ki), miscvartype%DistrLoad_QP(4:6, i, j)); if (allocated(error)) return + end do + end do + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) +end subroutine + +subroutine test_BD_InputGlobalLocal(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - a simple rotation does the rotation + + ! Check the following quanities are actually rotated + !! 1 Displacements -> u%RootMotion%TranslationDisp(:,1) + !! 2 Linear/Angular velocities -> u%RootMotion%TranslationVel(:,1), u%RootMotion%RotationVel(:,1) + !! 3 Linear/Angular accelerations -> u%RootMotion%TranslationAcc(:,1), u%RootMotion%RotationAcc(:,1) + !! 4 Point forces/moments -> u%PointLoad%Force(1:3,i), u%PointLoad%Moment(1:3,i) + !! 5 Distributed forces/moments -> u%DistrLoad%Force(1:3,i), u%DistrLoad%Moment(1:3,i) + + ! Verify the DCM is transposed + !! u%RootMotion%Orientation(:,:,1) + + integer :: i, totalnodes + type(BD_ParameterType) :: parametertype + type(BD_OtherStateType) :: otherstate + type(BD_InputType) :: inputtype + real(BDKi), dimension(3) :: vectorInit, vectorAfterRotation, rotationaxis + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "test_BD_InputGlobalLocal:" + + totalnodes = 2 + vectorInit = [0.0, 0.0, 1.0] + vectorAfterRotation = [0.0, 0.0, -1.0] + rotationaxis = [1.0, 0.0, 0.0] + + ! build the parameter type + parametertype%node_total = totalnodes + otherstate = simpleOtherState() + otherstate%GlbRot = calcRotationMatrix(real(Pi, BDKi), rotationaxis) + + ! build the inputs + call AllocAry(inputtype%RootMotion%TranslationDisp, 3, 1, 'TranslationDisp', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%TranslationVel, 3, 1, 'TranslationVel', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%RotationVel, 3, 1, 'RotationVel', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%TranslationAcc, 3, 1, 'TranslationAcc', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%RotationAcc, 3, 1, 'RotationAcc', ErrStat, ErrMsg) + inputtype%RootMotion%TranslationDisp(:, 1) = vectorInit + inputtype%RootMotion%TranslationVel(:, 1) = vectorInit + inputtype%RootMotion%RotationVel(:, 1) = vectorInit + inputtype%RootMotion%TranslationAcc(:, 1) = vectorInit + inputtype%RootMotion%RotationAcc(:, 1) = vectorInit + + call AllocAry(inputtype%PointLoad%Force, 3, totalnodes, 'PointLoad%Force', ErrStat, ErrMsg) + call AllocAry(inputtype%PointLoad%Moment, 3, totalnodes, 'PointLoad%Moment', ErrStat, ErrMsg) + do i = 1, parametertype%node_total + inputtype%PointLoad%Force(1:3, i) = vectorInit + inputtype%PointLoad%Moment(1:3, i) = vectorInit + end do + + inputtype%DistrLoad%Nnodes = totalnodes + call AllocAry(inputtype%DistrLoad%Force, 3, totalnodes, 'DistrLoad%Force', ErrStat, ErrMsg) + call AllocAry(inputtype%DistrLoad%Moment, 3, totalnodes, 'DistrLoad%Moment', ErrStat, ErrMsg) + do i = 1, inputtype%DistrLoad%Nnodes + inputtype%DistrLoad%Force(1:3, i) = vectorInit + inputtype%DistrLoad%Moment(1:3, i) = vectorInit + end do + + call AllocAry(inputtype%RootMotion%Orientation, 3, 3, totalnodes, 'RootMotion%Orientation', ErrStat, ErrMsg) + inputtype%RootMotion%Orientation(:, :, 1) = otherstate%GlbRot + + ! call the subroutine to test + call BD_InputGlobalLocal(parametertype, otherstate, inputtype) + + ! test the values + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%TranslationDisp(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%TranslationVel(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%RotationVel(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%TranslationAcc(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%RotationAcc(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + + do i = 1, parametertype%node_total + call check_array(error, vectorAfterRotation, real(inputtype%PointLoad%Force(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%PointLoad%Moment(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + end do + + inputtype%DistrLoad%Nnodes = totalnodes + do i = 1, inputtype%DistrLoad%Nnodes + call check_array(error, vectorAfterRotation, real(inputtype%DistrLoad%Force(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%DistrLoad%Moment(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + end do + + call check_array(error, transpose(otherstate%GlbRot), inputtype%RootMotion%Orientation(:, :, 1), testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_GravityForce(error) + type(error_type), allocatable, intent(out) :: error + integer :: i, j + real(BDKi) :: gravity(3) + type(BD_ParameterType) :: parametertype + type(BD_MiscVarType) :: miscvartype + real(BDKi) :: baseline(6) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "static simple beam under gravity:" + baseline(1:3) = getGravityInZ() + baseline(4:6) = [0.0, 0.0, 0.0] + + ! allocate and build the custom types + parametertype = simpleParameterType(1, 16, 16, 0, 1) + miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) + + gravity = getGravityInZ() + + ! call the subroutine to test + call BD_GravityForce(1, parametertype, miscvartype, gravity) + + ! test the values + call check_array(error, baseline, miscvartype%qp%Fg(:, 1, 1), testname, tolerance); if (allocated(error)) return + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + +end subroutine + +subroutine test_BD_QPData_mEta_rho(error) + type(error_type), allocatable, intent(out) :: error + integer :: i, j + type(BD_MiscVarType) :: miscvartype + type(BD_ParameterType) :: parametertype + real(BDKi) :: baselineRho(3, 3), baselineRR0mEta(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! -------------------------------------------------------------------------- + testname = "static simple beam under gravity:" + + baselineRho(1, :) = [1.0, 0.0, 0.0] + baselineRho(2, :) = [0.0, 1.0, 0.0] + baselineRho(3, :) = [0.0, 0.0, 2.0] + + baselineRR0mEta = [0.0, 0.0, 0.0] + + ! allocate and build the custom input types + parametertype = simpleParameterType(1, 16, 16, 0, 1) + miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) + + ! allocate the results + call BD_QPData_mEta_rho(parametertype, miscvartype) + + do j = 1, parametertype%elem_total + do i = 1, parametertype%nqp + call check_array(error, baselineRho, miscvartype%qp%rho(:, :, i, j), testname, tolerance); if (allocated(error)) return + call check_array(error, baselineRR0mEta, miscvartype%qp%RR0mEta(:, i, j), testname, tolerance); if (allocated(error)) return + end do + end do + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_QPData_mEta_rho.F90 b/modules/beamdyn/tests/test_BD_QPData_mEta_rho.F90 deleted file mode 100644 index 19a9cb5ab6..0000000000 --- a/modules/beamdyn/tests/test_BD_QPData_mEta_rho.F90 +++ /dev/null @@ -1,50 +0,0 @@ -@test -subroutine test_BD_QPData_mEta_rho() - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, j - type(BD_MiscVarType) :: miscvartype - type(BD_ParameterType) :: parametertype - real(BDKi) :: baselineRho(3,3), baselineRR0mEta(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - - baselineRho(1,:) = (/ 1.0, 0.0, 0.0 /) - baselineRho(2,:) = (/ 0.0, 1.0, 0.0 /) - baselineRho(3,:) = (/ 0.0, 0.0, 2.0 /) - - baselineRR0mEta = (/ 0.0, 0.0, 0.0 /) - - ! allocate and build the custom input types - parametertype = simpleParameterType(1,16,16,0,1) - miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) - - ! allocate the results - call BD_QPData_mEta_rho(parametertype, miscvartype) - - do j=1, parametertype%elem_total - do i=1, parametertype%nqp - @assertEqual(baselineRho, miscvartype%qp%rho(:,:,i,j), tolerance, testname) - @assertEqual(baselineRR0mEta, miscvartype%qp%RR0mEta(:,i,j), tolerance, testname) - end do - end do - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) -end subroutine diff --git a/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 b/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 index fcf4f75a4f..e55770824b 100644 --- a/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 +++ b/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 @@ -1,279 +1,268 @@ module test_BD_QuadraturePointData - ! Tests the following routines: - ! BD_QuadraturePointDataAt0 - ! BD_DisplacementQP - ! BD_RotationalInterpQP - ! BD_StifAtDeformedQP - ! - ! Assumes BD_InitShpDerJaco is tested elsewhere; but implicitly tests it here - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - type(BD_ParameterType) :: p - type(BD_ContinuousStateType) :: x !< Continuous states at t - type(BD_MiscVarType) :: m !< misc/optimization variables - - integer(IntKi) :: idx_qp, idx_node, i, j - integer(IntKi) :: nodes_per_elem - integer(IntKi) :: elem_total - integer(IntKi) :: nelem - integer(IntKi) :: nqp - - real(BDKi), allocatable :: gll_nodes(:) - real(BDKi), allocatable :: baseline_uu0(:,:,:) - real(BDKi), allocatable :: baseline_rrN0(:,:,:) - real(BDKi), allocatable :: baseline_E10(:,:,:) - - real(BDKi), allocatable :: baseline_uuu(:,:,:) - real(BDKi), allocatable :: baseline_uup(:,:,:) - real(BDKi), allocatable :: baseline_E1(:,:,:) - - real(BDKi), allocatable :: baseline_kappa(:,:,:) - real(BDKi), allocatable :: baseline_Nrrr(:,:,:) - real(BDKi), allocatable :: baseline_RR0(:,:,:,:) - - real(BDKi), allocatable :: baseline_Stif(:,:,:,:) - - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance +! Tests the following routines: +! BD_QuadraturePointDataAt0 +! BD_DisplacementQP +! BD_RotationalInterpQP +! BD_StifAtDeformedQP +! +! Assumes BD_InitShpDerJaco is tested elsewhere; but implicitly tests it here + +use BeamDyn +use NWTC_Num +use test_tools + +implicit none + +private +public :: test_BD_QuadraturePointData_suite contains - @test - subroutine test_BD_QuadraturePointData_5node() - ! branches to test - ! - 5 node, 1 element; deformed - ! - ! tests the initial values at nodes, and the interpolated values at a single quadrature point - ! test results were created with mathematica - ! - ! DETAILS ABOUT UNDERLYING MODEL - ! Reference-line definition on 0 <= t <= 1 - ! fx[t_] = t - 2. t^4; - ! fy[t_] = -2 t + 3. t^2; - ! fz[t_] = 5. t; - ! ft[t_] = 90. t^2; - ! Length of undeformed line: 5.82222272658737 - ! - ! Displacement, 0 <= t <= 1 - ! ux[t_] = t^2; - ! uy[t_] = t^3 - t^2; - ! uz[t_] = t^2 + 0.2 t^3; - ! ucrv1[t_] = 0.1 t^2; - ! ucrv2[t_] = 0.2 t; - ! ucrv3[t_] = 0.1 t^3; - ! - ! Length of deformed line: 6.75332330098143 - ! - ! For 5 nodes (p=4), nodes located at {-1., -0.654654, 0., 0.654654, 1.} - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-13 - - ! -------------------------------------------------------------------------- - testname = "5 node, 1 element, 1 qp, curved:" - - nodes_per_elem = 5 ! fourth-order polynomial representation - elem_total = 1 - nqp = 1 ! we are testing at a single, randomly chosen quadrature point - - p = simpleparametertype(elem_total,nodes_per_elem,nqp,0,1) - - call AllocAry(baseline_uu0 , p%dof_node, p%nqp, p%elem_total, 'baseline_uu0' , ErrStat, ErrMsg) - call AllocAry(baseline_E10 , p%dof_node/2, p%nqp, p%elem_total, 'baseline_E10' , ErrStat, ErrMsg) - call AllocAry(baseline_rrN0 , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_rrN0' , ErrStat, ErrMsg) - - call AllocAry(baseline_uuu , p%dof_node, p%nqp, p%elem_total, 'baseline_uuu' , ErrStat, ErrMsg) - call AllocAry(baseline_uup , p%dof_node/2, p%nqp, p%elem_total, 'baseline_uup' , ErrStat, ErrMsg) - call AllocAry(baseline_E1 , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_E1' , ErrStat, ErrMsg) - - call AllocAry(baseline_kappa, p%dof_node/2, p%nqp, p%elem_total, 'baseline_kappa' , ErrStat, ErrMsg) - call AllocAry(baseline_Nrrr , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_Nrrr' , ErrStat, ErrMsg) - - call AllocAry(baseline_RR0 , 3, 3, p%nqp, p%elem_total, 'baseline_RR0' , ErrStat, ErrMsg) - - call AllocAry(baseline_Stif , 6, 6, p%nqp, p%elem_total, 'baseline_Stif' , ErrStat, ErrMsg) - - ! assign baseline results - - ! uuN0 is of dimension (6 dof, nodes_per_elem, elem_total) - ! The following comes directly from the fx,fy,fz,ft defined above evaluated at the nodes - p%uuN0(1:3,1,1) = (/ 0.0, 0.0, 0.0 /) - p%uuN0(4:6,1,1) = (/ 0.37396158360688636,0.1958165026139741,-0.03702949411114144 /) - - p%uuN0(1:3,2,1) = (/ 0.17089517433538276,-0.2558982639254171,0.8633658232300558 /) - p%uuN0(4:6,2,1) = (/ 0.19122693263749954,0.18476700337274984,0.028875646293600333 /) - - p%uuN0(1:3,3,1) = (/ 0.375,-0.24999999999999997,2.5 /) - p%uuN0(4:6,3,1) = (/ -0.19563492419200498,0.03891420591317169,0.3929953248730882 /) - - p%uuN0(1:3,4,1) = (/ -0.10967068453946444,0.3987554067825597,4.136634176769939 /) - p%uuN0(4:6,4,1) = (/ -0.7291347777813711,-0.3147268839962532,0.9114830702745595 /) - - p%uuN0(1:3,5,1) = (/ -1., 1., 5. /) - p%uuN0(4:6,5,1) = (/ -1.0730193445455083,-0.42803085368057275,1.292451050059679 /) - - - ! the following is uuN0(4:6) with rotation of first node removed - baseline_rrN0(1:3,1,1) = (/ 0., 0., 0. /) - baseline_rrN0(1:3,2,1) = (/ -0.18695562365337798,-0.0032641497706398077,0.048935661676787534 /) - baseline_rrN0(1:3,3,1) = (/ -0.6080640291857297,-0.08595023366039768,0.4027112581652146 /) - baseline_rrN0(1:3,4,1) = (/ -1.1980591841054526,-0.3478409509012645,0.9658032687192992 /) - baseline_rrN0(1:3,5,1) = (/ -1.5856082606694464,-0.3853274394272689,1.3714709059387975 /) - - ! We are just looking at one randomly selected point in the domain to test interpolation; can be expanded - p%QptN(1) = 0.3 - - ! Input baseline/reference quantities; uu0 and E10 are only for at quadrature points, so just 1 point here - ! uu0 is reference line evaluated at quadrature point - ! E10 is tangent evaluated at qudrature point - baseline_uu0(1:3,1,1) = (/ 0.29298750000000007,-0.03250000000000007,3.2499999999999996 /) - baseline_uu0(4:6,1,1) = (/ -0.419497643454797,-0.1153574679103733,0.610107968645409 /) - baseline_E10(1:3,1,1) = (/ -0.22332806017852783,0.3449485111415417,0.9116661133321399 /) - - ! Allocate memory for GLL node positions in 1D parametric space - call AllocAry(gll_nodes, nodes_per_elem, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. /) - - ! Build the shape functions and derivative of shape functions evaluated at QP points; this is tested elsewhere - call BD_InitShpDerJaco(gll_nodes, p) - - ! **** primary function being tested ***** - call BD_QuadraturePointDataAt0( p ) - - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: rrN0" - @assertEqual(baseline_rrN0(:,:,1), p%rrN0(:,:,1), tolerance, testname) - - ! Test uu0; only one quadrature point for now - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: uu0" - do idx_qp = 1, p%nqp - @assertEqual(baseline_uu0(:,idx_qp,1), p%uu0(:,idx_qp,1), tolerance, testname) - end do - - ! Test E10; only one quadrature point for now - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: E10" - do idx_qp = 1, p%nqp - @assertEqual(baseline_E10(:,idx_qp,1), p%E10(:,idx_qp,1), tolerance, testname) - end do - - ! Now test "displacement" components at quadrature points by testing the three subroutine calls - ! in BD_QuadraturePointData: BD_DisplacementQP, BD_RotationalInterpQP, BD_StifAtDeformedQP - - x = simpleContinuousStateType(nodes_per_elem, nodes_per_elem, elem_total) - m = simpleMiscVarType(nqp, p%dof_node, elem_total, nodes_per_elem) - - x%q(1:3,1) = (/ 0., 0., 0. /) - x%q(4:6,1) = (/ 0., 0., 0. /) - - x%q(1:3,2) = (/ 0.02981602178886858,-0.02466759494943021,0.030845707156756254 /) - x%q(4:6,2) = (/ 0.0029816021788868583,0.034534632929202294, 0.000514842683943837 /) - - x%q(1:3,3) = (/ 0.25,-0.125,0.275 /) - x%q(4:6,3) = (/ 0.025,0.1,0.0125 /) - - x%q(1:3,4) = (/ 0.6844696924968456,-0.11818954790771263,0.7977257214146722 /) - x%q(4:6,4) = (/ 0.06844696924968456,0.16546536707079773,0.0566280144589133/) - - x%q(1:3,5) = (/ 1.,0.,1.2 /) - x%q(4:6,5) = (/ 0.1,0.2,0.1 /) - - idx_qp = 1 - nelem = 1 - baseline_uuu(1:3,idx_qp,nelem) = (/ 0.42250000000000015,-0.14787500000000003,0.4774250000000001 /) - baseline_uuu(4:6,idx_qp,nelem) = (/ 0.042250000000000024,0.1300000000000001,0.02746250000000002 /) - baseline_uup(1:3,idx_qp,nelem) = (/ 0.23717727987485349,-0.005929431996871376,0.2834268494504499 /) - baseline_E1(1:3, idx_qp,nelem) = (/ 0.01384921969632566, 0.33901907914467033, 1.1950929627825897 /) - - call BD_DisplacementQP( nelem, p, x, m ) - - do idx_qp = 1, p%nqp - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uuu" - @assertEqual(baseline_uuu(1:3,idx_qp,1), m%qp%uuu(1:3,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uup" - @assertEqual(baseline_uup(1:3,idx_qp,1), m%qp%uup(1:3,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: E1" - @assertEqual(baseline_E1(1:3,idx_qp,1), m%qp%E1(1:3,idx_qp,1), tolerance, testname) - end do - - ! because x%q(4:6,1)=(0.,0.,0.) we don't have to rotate xq to get Nrrrr - baseline_Nrrr(1:3,1,nelem) = x%q(4:6,1) - baseline_Nrrr(1:3,2,nelem) = x%q(4:6,2) - baseline_Nrrr(1:3,3,nelem) = x%q(4:6,3) - baseline_Nrrr(1:3,4,nelem) = x%q(4:6,4) - baseline_Nrrr(1:3,5,nelem) = x%q(4:6,5) - - baseline_kappa(1:3,1,1) = (/ 0.024664714695954715,0.036297077098213545,0.02229356260962948 /) - - baseline_RR0(1,1:3,1,nelem) = (/0.7967507798136657,-0.5939809735620473,-0.11124206898740374/) - baseline_RR0(2,1:3,1,nelem) = (/0.5966254150993577,0.7439195402109748,0.3010346022466711 /) - baseline_RR0(3,1:3,1,nelem) = (/-0.09605367730511442,-0.30621939967705303,0.9471026186942948 /) - - CALL BD_RotationalInterpQP( nelem, p, x, m ) - - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%Nrrr(1:3)" - do idx_node = 1, nodes_per_elem - @assertEqual(baseline_Nrrr(1:3,idx_node,1), m%Nrrr(1:3,idx_node,1), tolerance, testname) - end do - - do idx_qp = 1, p%nqp - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%uuu(4:6)" - @assertEqual(baseline_uuu(4:6,idx_qp,1), m%qp%uuu(4:6,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%kappa" - @assertEqual(baseline_kappa(1:3,idx_qp,1), m%qp%kappa(1:3,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%RR0" - @assertEqual(baseline_RR0(1:3,1:3,idx_qp,1), m%qp%RR0(1:3,1:3,idx_qp,1), tolerance, testname) - end do - - idx_qp = 1 - nelem = 1 - do i = 1, 6 - do j = 1, 6 - p%Stif0_QP(i,j,idx_qp) = float(i*j)*10.+float(i)*10. ! rather randomly chosen way to fully populate p%Stif0_QP - enddo - enddo - ! the following should be the result from MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) - baseline_Stif(1,1:6,idx_qp,nelem) = (/4.5918231909187375, -33.558422946165074, -19.41124878362651, 2.60126686515566, -69.25969416961556, -31.26026770547517 /) - baseline_Stif(2,1:6,idx_qp,nelem) = (/-18.923545538732206, 138.2989541247406, 79.99647091096304, -10.720184539884109, 285.4288856786646, 128.8279349796045 /) - baseline_Stif(3,1:6,idx_qp,nelem) = (/ -13.509458152867301, 98.7311774904666, 57.109222684340786, -7.65310518243836, 203.76676129761876, 91.96984745617996 /) - baseline_Stif(4,1:6,idx_qp,nelem) = (/ 2.852586665816869, -20.847560074045475, -12.058885358769254, 1.6159897420374438, -43.026325677681456, -19.419872917332995 /) - baseline_Stif(5,1:6,idx_qp,nelem) = (/-50.11731488891121, 366.27238899233606, 211.8634858589486, -28.39144827024861, 755.9328304872744, 341.18924335009 /) - baseline_Stif(6,1:6,idx_qp,nelem) = (/-23.86246662028767, 174.39407269994138, 100.87502434184734, -13.518082286573822, 359.9239499295936, 162.45117977068867 /) - - CALL BD_StifAtDeformedQP( nelem, p, m ) +!> Collect all exported unit tests +subroutine test_BD_QuadraturePointData_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_BD_QuadraturePointData_5node", test_BD_QuadraturePointData_5node)] + end subroutine + +subroutine test_BD_QuadraturePointData_5node(error) + type(error_type), allocatable, intent(out) :: error - do idx_qp = 1, p%nqp - testname = "5 node, 1 element, 1 qp, curved: BD_StifAtDeformedQP: m%qp%Stif" - @assertEqual(baseline_Stif(1:6,1:6,idx_qp,1), m%qp%Stif(1:6,1:6,idx_qp,1), 10.*tolerance, testname) - end do - - ! dealocate baseline variables - if (allocated(gll_nodes)) deallocate(gll_nodes) - if (allocated(baseline_uu0)) deallocate(baseline_uu0) - if (allocated(baseline_E10)) deallocate(baseline_E10) - if (allocated(baseline_rrN0)) deallocate(baseline_rrN0) - if (allocated(baseline_rrN0)) deallocate(baseline_rrN0) - if (allocated(baseline_E10)) deallocate(baseline_E10) - if (allocated(baseline_uuu)) deallocate(baseline_uuu) - if (allocated(baseline_uup)) deallocate(baseline_uup) - if (allocated(baseline_E1)) deallocate(baseline_E1) - if (allocated(baseline_kappa)) deallocate(baseline_kappa) - if (allocated(baseline_Nrrr)) deallocate(baseline_Nrrr) - if (allocated(baseline_RR0)) deallocate(baseline_RR0) - if (allocated(baseline_Stif)) deallocate(baseline_Stif) - - call BD_DestroyParam( p, ErrStat, ErrMsg) - CALL BD_DestroyMisc( m, ErrStat, ErrMsg) - CALL BD_DestroyContState(x, ErrStat, ErrMsg) - - end subroutine + ! branches to test + ! - 5 node, 1 element; deformed + ! + ! tests the initial values at nodes, and the interpolated values at a single quadrature point + ! test results were created with mathematica + ! + ! DETAILS ABOUT UNDERLYING MODEL + ! Reference-line definition on 0 <= t <= 1 + ! fx[t_] = t - 2. t^4; + ! fy[t_] = -2 t + 3. t^2; + ! fz[t_] = 5. t; + ! ft[t_] = 90. t^2; + ! Length of undeformed line: 5.82222272658737 + ! + ! Displacement, 0 <= t <= 1 + ! ux[t_] = t^2; + ! uy[t_] = t^3 - t^2; + ! uz[t_] = t^2 + 0.2 t^3; + ! ucrv1[t_] = 0.1 t^2; + ! ucrv2[t_] = 0.2 t; + ! ucrv3[t_] = 0.1 t^3; + ! + ! Length of deformed line: 6.75332330098143 + ! + ! For 5 nodes (p=4), nodes located at {-1., -0.654654, 0., 0.654654, 1.} + + type(BD_ParameterType) :: p + type(BD_ContinuousStateType) :: x !< Continuous states at t + type(BD_MiscVarType) :: m !< misc/optimization variables + + integer(IntKi) :: idx_qp, idx_node, i, j + integer(IntKi) :: nodes_per_elem + integer(IntKi) :: elem_total + integer(IntKi) :: nelem + integer(IntKi) :: nqp + + real(BDKi), allocatable :: gll_nodes(:) + real(BDKi), allocatable :: baseline_uu0(:, :, :) + real(BDKi), allocatable :: baseline_rrN0(:, :, :) + real(BDKi), allocatable :: baseline_E10(:, :, :) + + real(BDKi), allocatable :: baseline_uuu(:, :, :) + real(BDKi), allocatable :: baseline_uup(:, :, :) + real(BDKi), allocatable :: baseline_E1(:, :, :) + + real(BDKi), allocatable :: baseline_kappa(:, :, :) + real(BDKi), allocatable :: baseline_Nrrr(:, :, :) + real(BDKi), allocatable :: baseline_RR0(:, :, :, :) + + real(BDKi), allocatable :: baseline_Stif(:, :, :, :) + + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-13 + + ! -------------------------------------------------------------------------- + testname = "5 node, 1 element, 1 qp, curved:" + + nodes_per_elem = 5 ! fourth-order polynomial representation + elem_total = 1 + nqp = 1 ! we are testing at a single, randomly chosen quadrature point + + p = simpleparametertype(elem_total, nodes_per_elem, nqp, 0, 1) + + call AllocAry(baseline_uu0, p%dof_node, p%nqp, p%elem_total, 'baseline_uu0', ErrStat, ErrMsg) + call AllocAry(baseline_E10, p%dof_node / 2, p%nqp, p%elem_total, 'baseline_E10', ErrStat, ErrMsg) + call AllocAry(baseline_rrN0, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'baseline_rrN0', ErrStat, ErrMsg) + + call AllocAry(baseline_uuu, p%dof_node, p%nqp, p%elem_total, 'baseline_uuu', ErrStat, ErrMsg) + call AllocAry(baseline_uup, p%dof_node / 2, p%nqp, p%elem_total, 'baseline_uup', ErrStat, ErrMsg) + call AllocAry(baseline_E1, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'baseline_E1', ErrStat, ErrMsg) + + call AllocAry(baseline_kappa, p%dof_node / 2, p%nqp, p%elem_total, 'baseline_kappa', ErrStat, ErrMsg) + call AllocAry(baseline_Nrrr, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'baseline_Nrrr', ErrStat, ErrMsg) + + call AllocAry(baseline_RR0, 3, 3, p%nqp, p%elem_total, 'baseline_RR0', ErrStat, ErrMsg) + + call AllocAry(baseline_Stif, 6, 6, p%nqp, p%elem_total, 'baseline_Stif', ErrStat, ErrMsg) + + ! assign baseline results + + ! uuN0 is of dimension (6 dof, nodes_per_elem, elem_total) + ! The following comes directly from the fx,fy,fz,ft defined above evaluated at the nodes + p%uuN0(1:3, 1, 1) = [0.0, 0.0, 0.0] + p%uuN0(4:6, 1, 1) = [0.37396158360688636, 0.1958165026139741, -0.03702949411114144] + + p%uuN0(1:3, 2, 1) = [0.17089517433538276, -0.2558982639254171, 0.8633658232300558] + p%uuN0(4:6, 2, 1) = [0.19122693263749954, 0.18476700337274984, 0.028875646293600333] + + p%uuN0(1:3, 3, 1) = [0.375, -0.24999999999999997, 2.5] + p%uuN0(4:6, 3, 1) = [-0.19563492419200498, 0.03891420591317169, 0.3929953248730882] + + p%uuN0(1:3, 4, 1) = [-0.10967068453946444, 0.3987554067825597, 4.136634176769939] + p%uuN0(4:6, 4, 1) = [-0.7291347777813711, -0.3147268839962532, 0.9114830702745595] + + p%uuN0(1:3, 5, 1) = [-1., 1., 5.] + p%uuN0(4:6, 5, 1) = [-1.0730193445455083, -0.42803085368057275, 1.292451050059679] + + ! the following is uuN0(4:6) with rotation of first node removed + baseline_rrN0(1:3, 1, 1) = [0., 0., 0.] + baseline_rrN0(1:3, 2, 1) = [-0.18695562365337798, -0.0032641497706398077, 0.048935661676787534] + baseline_rrN0(1:3, 3, 1) = [-0.6080640291857297, -0.08595023366039768, 0.4027112581652146] + baseline_rrN0(1:3, 4, 1) = [-1.1980591841054526, -0.3478409509012645, 0.9658032687192992] + baseline_rrN0(1:3, 5, 1) = [-1.5856082606694464, -0.3853274394272689, 1.3714709059387975] + + ! We are just looking at one randomly selected point in the domain to test interpolation; can be expanded + p%QptN(1) = 0.3 + + ! Input baseline/reference quantities; uu0 and E10 are only for at quadrature points, so just 1 point here + ! uu0 is reference line evaluated at quadrature point + ! E10 is tangent evaluated at qudrature point + baseline_uu0(1:3, 1, 1) = [0.29298750000000007, -0.03250000000000007, 3.2499999999999996] + baseline_uu0(4:6, 1, 1) = [-0.419497643454797, -0.1153574679103733, 0.610107968645409] + baseline_E10(1:3, 1, 1) = [-0.22332806017852783, 0.3449485111415417, 0.9116661133321399] + + ! Allocate memory for GLL node positions in 1D parametric space + call AllocAry(gll_nodes, nodes_per_elem, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [-1., -0.6546536707079771, 0., 0.6546536707079771, 1.] + + ! Build the shape functions and derivative of shape functions evaluated at QP points; this is tested elsewhere + call BD_InitShpDerJaco(gll_nodes, p) + + ! **** primary function being tested ***** + call BD_QuadraturePointDataAt0(p) + + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: rrN0" + call check_array(error, baseline_rrN0(:, :, 1), p%rrN0(:, :, 1), testname, tolerance); if (allocated(error)) return + + ! Test uu0; only one quadrature point for now + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: uu0" + do idx_qp = 1, p%nqp + call check_array(error, baseline_uu0(:, idx_qp, 1), p%uu0(:, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + ! Test E10; only one quadrature point for now + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: E10" + do idx_qp = 1, p%nqp + call check_array(error, baseline_E10(:, idx_qp, 1), p%E10(:, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + ! Now test "displacement" components at quadrature points by testing the three subroutine calls + ! in BD_QuadraturePointData: BD_DisplacementQP, BD_RotationalInterpQP, BD_StifAtDeformedQP + + x = simpleContinuousStateType(nodes_per_elem, nodes_per_elem, elem_total) + m = simpleMiscVarType(nqp, p%dof_node, elem_total, nodes_per_elem) + + x%q(1:3, 1) = [0., 0., 0.] + x%q(4:6, 1) = [0., 0., 0.] + + x%q(1:3, 2) = [0.02981602178886858, -0.02466759494943021, 0.030845707156756254] + x%q(4:6, 2) = [0.0029816021788868583, 0.034534632929202294, 0.000514842683943837] + + x%q(1:3, 3) = [0.25, -0.125, 0.275] + x%q(4:6, 3) = [0.025, 0.1, 0.0125] + + x%q(1:3, 4) = [0.6844696924968456, -0.11818954790771263, 0.7977257214146722] + x%q(4:6, 4) = [0.06844696924968456, 0.16546536707079773, 0.0566280144589133] + + x%q(1:3, 5) = [1., 0., 1.2] + x%q(4:6, 5) = [0.1, 0.2, 0.1] + + idx_qp = 1 + nelem = 1 + baseline_uuu(1:3, idx_qp, nelem) = [0.42250000000000015, -0.14787500000000003, 0.4774250000000001] + baseline_uuu(4:6, idx_qp, nelem) = [0.042250000000000024, 0.1300000000000001, 0.02746250000000002] + baseline_uup(1:3, idx_qp, nelem) = [0.23717727987485349, -0.005929431996871376, 0.2834268494504499] + baseline_E1(1:3, idx_qp, nelem) = [0.01384921969632566, 0.33901907914467033, 1.1950929627825897] + + call BD_DisplacementQP(nelem, p, x, m) + + do idx_qp = 1, p%nqp + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uuu" + call check_array(error, baseline_uuu(1:3, idx_qp, 1), m%qp%uuu(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uup" + call check_array(error, baseline_uup(1:3, idx_qp, 1), m%qp%uup(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: E1" + call check_array(error, baseline_E1(1:3, idx_qp, 1), m%qp%E1(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + ! because x%q(4:6,1)=(0.,0.,0.) we don't have to rotate xq to get Nrrrr + baseline_Nrrr(1:3, 1, nelem) = x%q(4:6, 1) + baseline_Nrrr(1:3, 2, nelem) = x%q(4:6, 2) + baseline_Nrrr(1:3, 3, nelem) = x%q(4:6, 3) + baseline_Nrrr(1:3, 4, nelem) = x%q(4:6, 4) + baseline_Nrrr(1:3, 5, nelem) = x%q(4:6, 5) + + baseline_kappa(1:3, 1, 1) = [0.024664714695954715, 0.036297077098213545, 0.02229356260962948] + + baseline_RR0(1, 1:3, 1, nelem) = [0.7967507798136657, -0.5939809735620473, -0.11124206898740374] + baseline_RR0(2, 1:3, 1, nelem) = [0.5966254150993577, 0.7439195402109748, 0.3010346022466711] + baseline_RR0(3, 1:3, 1, nelem) = [-0.09605367730511442, -0.30621939967705303, 0.9471026186942948] + + call BD_RotationalInterpQP(nelem, p, x, m) + + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%Nrrr(1:3)" + do idx_node = 1, nodes_per_elem + call check_array(error, baseline_Nrrr(1:3, idx_node, 1), m%Nrrr(1:3, idx_node, 1), testname, tolerance); if (allocated(error)) return + end do + + do idx_qp = 1, p%nqp + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%uuu(4:6)" + call check_array(error, baseline_uuu(4:6, idx_qp, 1), m%qp%uuu(4:6, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%kappa" + call check_array(error, baseline_kappa(1:3, idx_qp, 1), m%qp%kappa(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%RR0" + call check_array(error, baseline_RR0(1:3, 1:3, idx_qp, 1), m%qp%RR0(1:3, 1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + idx_qp = 1 + nelem = 1 + do i = 1, 6 + do j = 1, 6 + p%Stif0_QP(i, j, idx_qp) = float(i * j) * 10.+float(i) * 10. ! rather randomly chosen way to fully populate p%Stif0_QP + end do + end do + ! the following should be the result from MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) + baseline_Stif(1, 1:6, idx_qp, nelem) = [4.5918231909187375, -33.558422946165074, -19.41124878362651, 2.60126686515566, -69.25969416961556, -31.26026770547517] + baseline_Stif(2, 1:6, idx_qp, nelem) = [-18.923545538732206, 138.2989541247406, 79.99647091096304, -10.720184539884109, 285.4288856786646, 128.8279349796045] + baseline_Stif(3, 1:6, idx_qp, nelem) = [-13.509458152867301, 98.7311774904666, 57.109222684340786, -7.65310518243836, 203.76676129761876, 91.96984745617996] + baseline_Stif(4, 1:6, idx_qp, nelem) = [2.852586665816869, -20.847560074045475, -12.058885358769254, 1.6159897420374438, -43.026325677681456, -19.419872917332995] + baseline_Stif(5, 1:6, idx_qp, nelem) = [-50.11731488891121, 366.27238899233606, 211.8634858589486, -28.39144827024861, 755.9328304872744, 341.18924335009] + baseline_Stif(6, 1:6, idx_qp, nelem) = [-23.86246662028767, 174.39407269994138, 100.87502434184734, -13.518082286573822, 359.9239499295936, 162.45117977068867] + + call BD_StifAtDeformedQP(nelem, p, m) + + do idx_qp = 1, p%nqp + testname = "5 node, 1 element, 1 qp, curved: BD_StifAtDeformedQP: m%qp%Stif" + call check_array(error, baseline_Stif(1:6, 1:6, idx_qp, 1), m%qp%Stif(1:6, 1:6, idx_qp, 1), testname, 10.0_DbKi * tolerance); if (allocated(error)) return + end do + + call BD_DestroyParam(p, ErrStat, ErrMsg) + call BD_DestroyMisc(m, ErrStat, ErrMsg) + call BD_DestroyContState(x, ErrStat, ErrMsg) + +end subroutine + end module diff --git a/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 b/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 new file mode 100644 index 0000000000..0e56302615 --- /dev/null +++ b/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 @@ -0,0 +1,375 @@ +module test_BD_ShapeFuncs + +use BeamDyn +use test_tools +use BeamDyn_Subs + +implicit none + +private +public :: test_BD_ShapeFuncs_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_ShapeFuncs_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_GenerateGLL", test_BD_GenerateGLL), & + new_unittest("test_BD_GaussPointWeight", test_BD_GaussPointWeight), & + new_unittest("test_BD_InitShpDerJaco_5node", test_BD_InitShpDerJaco_5node) & + ] +end subroutine + +subroutine test_BD_GenerateGLL(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - p = 2, boundaries only + ! - p = 5, odd number + ! - p = 6, even number + ! - p = 97, large, prime number + + integer :: p + real(BDKi), allocatable :: gll_nodes(:), baseline(:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature + ! this website provides the nodes and weights: + ! http://keisan.casio.com/exec/system/1280801905 + + + ! -------------------------------------------------------------------------- + testname = "p = 2, boundaries only:" + p = 2 + allocate(baseline(p)) + baseline = [ -1.0, 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + ! -------------------------------------------------------------------------- + testname = "p = 5, odd number:" + p = 5 + allocate(baseline(p)) + baseline = [ -1.0, -0.6546536707079771437983, 0.0, 0.654653670707977143798, 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + + ! -------------------------------------------------------------------------- + testname = "p = 6, even number:" + p = 6 + allocate(baseline(p)) + baseline = [ -1.0, -0.765055323929464692851, -0.2852315164806450963142, 0.2852315164806450963142, 0.765055323929464692851, 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + + ! -------------------------------------------------------------------------- + testname = "p = 97, large, prime number:" + p = 97 + allocate(baseline(p)) + baseline = [ & + -1.0, -0.9992117675187679372925, -0.997358420211575308381, -0.994447829238317218534, & + -0.9904833045655763827779, -0.9854690874505481580336, -0.9794105031099910659294, -0.972313976393383949863, & + -0.964187029755659609253, -0.955038276712134050045, -0.944877413224633009627, -0.933715207638498109806, & + -0.921563489367936527388, -0.9084351364079280548151, -0.8943440617122115723236, -0.8793051984632038831786,& + -0.8633344842547974738284, -0.8464488442074511804343, -0.8286661730348553921423, -0.810005316081936147328, & + -0.7904860493547251817926, -0.7701290585635136140501, -0.748955917201652598455, -0.7269890636833281333, & + -0.704251777564599720681, -0.6807681548729427782946, -0.6565630825714660926978, -0.631662212184884059709, & + -0.6060919326152061877601, -0.579879342175961313997, -0.553052219874599625586, -0.5256389959735105979894,& + -0.4976687218608582506373, -0.4691710392631656985371, -0.440176148832277959663, -0.4107147781399945491769,& + -0.3808181491142908001982, -0.350517944951638397684, -0.3198462765404906463777, -0.2888356484315159109028,& + -0.257518924390642905356, -0.2259292925714235538959, -0.1941002303436225183436, -0.1620654688153067619161,& + -0.1298589570860333006308, -0.09751482626901823919031, -0.0650673533204149925476, -0.032550924714033997197, & + 0.0, 0.032550924714033997197, 0.0650673533204149925476, 0.0975148262690182391903,& + 0.1298589570860333006308, 0.1620654688153067619161, 0.194100230343622518344, 0.225929292571423553896, & + 0.257518924390642905356, 0.2888356484315159109028, 0.3198462765404906463777, 0.3505179449516383976839,& + 0.3808181491142908001982, 0.410714778139994549177, 0.4401761488322779596629, 0.4691710392631656985371,& + 0.4976687218608582506373, 0.5256389959735105979894, 0.5530522198745996255862, 0.579879342175961313997, & + 0.6060919326152061877601, 0.6316622121848840597089, 0.6565630825714660926978, 0.6807681548729427782946,& + 0.7042517775645997206813, 0.7269890636833281332999, 0.7489559172016525984547, 0.7701290585635136140501,& + 0.7904860493547251817926, 0.8100053160819361473279, 0.8286661730348553921423, 0.8464488442074511804343,& + 0.8633344842547974738284, 0.8793051984632038831786, 0.8943440617122115723236, 0.9084351364079280548151,& + 0.9215634893679365273879, 0.933715207638498109806, 0.9448774132246330096275, 0.955038276712134050045, & + 0.9641870297556596092534, 0.9723139763933839498625, 0.9794105031099910659294, 0.9854690874505481580336,& + 0.9904833045655763827779, 0.9944478292383172185338, 0.9973584202115753083808, 0.9992117675187679372925,& + 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + end subroutine + +subroutine test_BD_GaussPointWeight(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - p = 1, invalid value + ! - p = 2, boundaries only + ! - p = 5, odd number + ! - p = 6, even number + ! - p = 97, large, prime number + + integer :: p + real(BDKi), allocatable :: locations(:), weights(:) + real(BDKi), allocatable :: baselinelocations(:), baselineweights(:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-10 + + ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature + ! the Python Numpy package provides this functionality with numpy.polynomial.legendre.leggauss. + ! the first array returned are locations and the second are the weights + ! >>> from numpy import polynomial + ! >>> polynomial.legendre.leggauss(2) + ! (array([-0.57735027, 0.57735027]), array([ 1., 1.])) + ! >>> polynomial.legendre.leggauss(5) + ! (array([-0.90617985, -0.53846931, 0. , 0.53846931, 0.90617985]), array([ 0.23692689, 0.47862867, 0.56888889, 0.47862867, 0.23692689])) + + ! -------------------------------------------------------------------------- + testname = "p = 1, invalid value:" + p = 1 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.57735026919, 0.57735026919] + baselineweights = [1.0, 1.0] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check(error, 4, ErrStat, testname); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + + ! -------------------------------------------------------------------------- + testname = "p = 2, boundaries only:" + p = 2 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.57735026919, 0.57735026919] + baselineweights = [1.0, 1.0] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check_array(error, baselinelocations, locations, testname, tolerance); if (allocated(error)) return + call check_array(error, baselineweights, weights, testname, tolerance); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + + ! -------------------------------------------------------------------------- + testname = "p = 5, odd number:" + p = 5 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.906179845939, -0.538469310106, 0.0, 0.538469310106, 0.906179845939] + baselineweights = [0.236926885056, 0.478628670499, 0.568888888889, 0.478628670499, 0.236926885056] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check_array(error, baselinelocations, locations, testname, tolerance); if (allocated(error)) return + call check_array(error, baselineweights, weights, testname, tolerance); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + + ! -------------------------------------------------------------------------- + testname = "p = 6, even number:" + p = 6 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.932469514203, -0.661209386466, -0.238619186083, 0.238619186083, 0.661209386466, 0.932469514203] + baselineweights = [0.171324492379, 0.360761573048, 0.467913934573, 0.467913934573, 0.360761573048, 0.171324492379] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check_array(error, baselinelocations, locations, testname, tolerance); if (allocated(error)) return + call check_array(error, baselineweights, weights, testname, tolerance); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + +end subroutine + +subroutine test_BD_InitShpDerJaco_5node(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - 5 node, 1 element; undeformed + + integer(IntKi) :: i, j, idx_qp, nelem + type(BD_ParameterType) :: p + real(BDKi), allocatable :: gll_nodes(:), inp_QPtWeight(:) + real(BDKi), allocatable :: baseline_QPtWeight(:), baseline_QPtN(:) + real(BDKi), allocatable :: baseline_Shp(:,:), baseline_ShpDer(:,:), baseline_jacobian(:,:), baseline_QPtw_ShpDer(:,:) + real(BDKi), allocatable :: baseline_QPtw_Shp_ShpDer(:,:,:), baseline_QPtw_Shp_Jac(:,:,:) + real(BDKi), allocatable :: baseline_QPtw_Shp_Shp_Jac(:,:,:,:), baseline_QPtw_ShpDer_ShpDer_Jac(:,:,:,:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-13 + + ! -------------------------------------------------------------------------- + testname = "5 node, 1 element, curved:" + + ! Let's use Gauss_Legendre Quadrature, which should be exact for intended polynomial test case + p = simpleparametertype(1,5,5,0,1) + + ! Allocate memory for baseline results + call AllocAry(baseline_Shp , p%nodes_per_elem, p%nqp, 'Reference Shp' , ErrStat, ErrMsg) + call AllocAry(baseline_ShpDer , p%nodes_per_elem, p%nqp, 'Reference ShpDer' , ErrStat, ErrMsg) + call AllocAry(baseline_Jacobian , p%nqp, p%elem_total, 'Reference Jacobian', ErrStat, ErrMsg) + call AllocAry(baseline_QPtN , p%nqp, 'Reference QPtN' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtWeight, p%nqp, 'Reference QPtWeight', ErrStat, ErrMsg) + + ! Allocate memory for other relevant variables belonging to module p + call AllocAry(baseline_QPtw_Shp_Shp_Jac , p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference QPtw_Shp_Shp_Jac' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference baseline_QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_Shp_ShpDer , p%nqp, p%nodes_per_elem, p%nodes_per_elem , 'reference QPtw_Shp_ShpDer' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_Shp_Jac , p%nqp, p%nodes_per_elem, p%elem_total , 'reference QPtw_Shp_Jac' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_ShpDer , p%nqp, p%nodes_per_elem , 'reference QPtw_ShpDer' , ErrStat, ErrMsg) + + ! assign baseline results + ! baseline quadrature points and weights; this is 5-point Gauss-Legendre quadrature + + baseline_QPtN(1:p%nqp) = [ -0.9061798459386640, -0.5384693101056831, 0. , 0.5384693101056831, 0.9061798459386640 ] + baseline_QPtWeight(1:p%nqp) = [ 0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891 ] + + ! assign baseline jacobian based; these values were calculated in separte mathematica script + baseline_jacobian(1:p%nqp,1) = [ 0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582 ] + + ! assign baseline shape functions based on example as described above + baseline_Shp(1,1:p%nqp) = [ 0.5933706960199465, -0.10048256880508302, 0., 0.030144110771879763, -0.029205077492916114 ] + baseline_Shp(2,1:p%nqp) = [ 0.516435198649618, 0.9313661019373962, 0., -0.09069490469997694, 0.08322282221996001 ] + baseline_Shp(3,1:p%nqp) = [ -0.16382363939660807, 0.22966726079578503, 1., 0.22966726079578503, -0.16382363939660807 ] + baseline_Shp(4,1:p%nqp) = [ 0.08322282221996001, -0.09069490469997694, 0., 0.9313661019373962, 0.516435198649618 ] + baseline_Shp(5,1:p%nqp) = [ -0.029205077492916114, 0.030144110771879763, 0., -0.10048256880508302, 0.5933706960199465 ] + + ! assign baseline shape function derivatives based on example as described above + baseline_ShpDer(1,1:p%nqp) = [ -3.705336453591454, -0.5287152679802739, 0.375, -0.24351802112960028, 0.14423640936799356 ] + baseline_ShpDer(2,1:p%nqp) = [ 4.33282116876393, -1.0976579678283382, -1.3365845776954537, 0.7497385700132875, -0.42067623042767965 ] + baseline_ShpDer(3,1:p%nqp) = [ -0.9039245362321631, 2.1325937846922898, 0., -2.1325937846922898, 0.9039245362321631 ] + baseline_ShpDer(4,1:p%nqp) = [ 0.42067623042767965, -0.7497385700132875, 1.3365845776954537, 1.0976579678283382, -4.33282116876393 ] + baseline_ShpDer(5,1:p%nqp) = [ -0.14423640936799356, 0.24351802112960028, -0.375, 0.5287152679802739, 3.705336453591454 ] + + ! uuN0 is of dimension (3 dof, nodes_per_elem, elem_total) + p%uuN0(1:3,1,1) = [ 0.0, 0.0, 0.0 ] + p%uuN0(1:3,2,1) = [ 0.16237631096713473, 0.17578464768961147, 0.1481911137890286 ] + p%uuN0(1:3,3,1) = [ 0.25, 1., 1.1875 ] + p%uuN0(1:3,4,1) = [ -0.30523345382427747, 2.4670724951675314, 2.953849702537502 ] + p%uuN0(1:3,5,1) = [ -1., 3.5, 4. ] + + ! Using BD_GaussPointWeight; hoping it's tested! + call BD_GaussPointWeight(p%nqp, p%QPtN, p%QPtWeight, ErrStat, ErrMsg) + + call check_array(error, baseline_QPtN, p%QPtN , testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtWeight, p%QPtWeight, testname, tolerance); if (allocated(error)) return + + ! Allocate memory for GLL node positions in 1D parametric space + call AllocAry(gll_nodes, p%nodes_per_elem, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. ] + + ! call the test subroutine + call BD_InitShpDerJaco(gll_nodes, p) + + ! check the baseline shape functions and their derivatives + call check_array(error, baseline_Shp , p%Shp , testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_ShpDer, p%ShpDer, testname, tolerance); if (allocated(error)) return + + ! check the baseline jacobian + call check_array(error, baseline_jacobian, p%jacobian, testname, tolerance); if (allocated(error)) return + + + ! Test and assemble variables N*N^T*wt*Jacobian and dN*dN^T*wt/Jacobian + do nelem = 1, p%elem_total + do idx_qp = 1, p%nqp + do j = 1, p%nodes_per_elem + do i = 1, p%nodes_per_elem + ! Check the variable N*N^T*Jacobian + baseline_QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = baseline_Shp(i,idx_qp)*baseline_Shp(j,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_jacobian(idx_qp,nelem) + + ! Check the variable dN*dN^T*Jacobian + baseline_QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = baseline_ShpDer(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp)/baseline_jacobian(idx_qp,nelem) + end do + end do + end do + end do + call check_array(error, baseline_QPtw_Shp_Shp_Jac, p%QPtw_Shp_Shp_Jac, testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtw_ShpDer_ShpDer_Jac, p%QPtw_ShpDer_ShpDer_Jac, testname, tolerance); if (allocated(error)) return + + ! Test and assemble variable N*dN^T*wt*Jacobian + do idx_qp = 1, p%nqp + do j = 1, p%nodes_per_elem + do i = 1, p%nodes_per_elem + baseline_QPtw_Shp_ShpDer(idx_qp,i,j) = baseline_Shp(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp) + end do + end do + end do + call check_array(error, baseline_QPtw_Shp_ShpDer, p%QPtw_Shp_ShpDer, testname, tolerance); if (allocated(error)) return + + ! Test and assemble variable N*wt*Jacobian + do nelem = 1, p%elem_total + do i = 1, p%nodes_per_elem + do idx_qp = 1, p%nqp + baseline_QPtw_Shp_Jac(idx_qp,i,nelem) = baseline_Shp(i,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_Jacobian(idx_qp,nelem) + end do + end do + end do + call check_array(error, baseline_QPtw_Shp_Jac, p%QPtw_Shp_Jac, testname, tolerance); if (allocated(error)) return + + ! Test and assemble variable dN*wt. + do i = 1, p%nodes_per_elem + do idx_qp = 1, p%nqp + baseline_QPtw_ShpDer(idx_qp,i) = baseline_ShpDer(i,idx_qp)*baseline_QPtWeight(idx_qp) + end do + end do + call check_array(error, baseline_QPtw_ShpDer, p%QPtw_ShpDer, testname, tolerance); if (allocated(error)) return + + call BD_DestroyParam(p, ErrStat, ErrMsg) + +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 b/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 index 0ca075ad1a..c8398f5b82 100644 --- a/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 +++ b/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 @@ -1,113 +1,125 @@ module test_BD_TrapezoidalPointWeight - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - type(BD_ParameterType) :: p - - integer(IntKi) :: nqp - integer(IntKi) :: refine - integer(IntKi) :: station_total - real(BDKi), allocatable :: station_eta(:) - real(BDKi), allocatable :: baseline_QPtN(:) - real(BDKi), allocatable :: baseline_QPtW(:) - - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance + +use test_tools +use BeamDyn + +implicit none + +private +public :: test_BD_TrapezoidalPointWeight_suite contains - @test - subroutine test_BD_TrapezoidalPointWeight_2station() - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "test_BD_TrapezoidalPointWeight_2station_8refine" +!> Collect all exported unit tests +subroutine test_BD_TrapezoidalPointWeight_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_TrapezoidalPointWeight_2station", test_BD_TrapezoidalPointWeight_2station), & + new_unittest("test_BD_TrapezoidalPointWeight_3station", test_BD_TrapezoidalPointWeight_3station) & + ] +end subroutine + +subroutine test_BD_TrapezoidalPointWeight_2station(error) + type(error_type), allocatable, intent(out) :: error + + type(BD_ParameterType) :: p + + integer(IntKi) :: nqp + integer(IntKi) :: refine + integer(IntKi) :: station_total + real(BDKi), allocatable :: station_eta(:) + real(BDKi), allocatable :: baseline_QPtN(:) + real(BDKi), allocatable :: baseline_QPtW(:) + + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "test_BD_TrapezoidalPointWeight_2station_8refine" + + station_total = 2 + + call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) + + ! simple case where we have enpoints only; typical with constant cross sections + station_eta(1:station_total) = (/0., 1./) + + refine = 8 + + nqp = (station_total - 1) * refine + 1 + + p = simpleParameterType(1, 1, nqp, 0, refine) + + call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) + call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) + + baseline_QPtN(1:nqp) = (/-1., -0.75, -0.5, -0.25, 0., 0.25, 0.5, 0.75, 1./) + baseline_QPtW(1:nqp) = (/0.125, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.125/) + + call BD_TrapezoidalPointWeight(p, station_eta, station_total) + + call check_array(error, baseline_QPtN, p%QPtN, testname, thr=tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtW, p%QPtWeight, testname, thr=tolerance); if (allocated(error)) return - station_total = 2 + deallocate (station_eta) + deallocate (baseline_QPtN) + deallocate (baseline_QPtW) - call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) + call BD_DestroyParam(p, ErrStat, ErrMsg) - ! simple case where we have enpoints only; typical with constant cross sections - station_eta(1:station_total) = (/0., 1./) +end subroutine - refine = 8 +subroutine test_BD_TrapezoidalPointWeight_3station(error) + type(error_type), allocatable, intent(out) :: error - nqp = (station_total - 1)*refine + 1 + type(BD_ParameterType) :: p - p=simpleParameterType(1,1,nqp,0,refine) + integer(IntKi) :: nqp + integer(IntKi) :: refine + integer(IntKi) :: station_total + real(BDKi), allocatable :: station_eta(:) + real(BDKi), allocatable :: baseline_QPtN(:) + real(BDKi), allocatable :: baseline_QPtW(:) - call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) - call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) - - baseline_QPtN(1:nqp) = (/ -1., -0.75, -0.5, -0.25, 0., 0.25, 0.5, 0.75, 1. /) - baseline_QPtW(1:nqp) = (/ 0.125, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.125 /) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname - call BD_TrapezoidalPointWeight(p, station_eta, station_total) - - @assertEqual(baseline_QPtN, p%QPtN, tolerance, testname) - @assertEqual(baseline_QPtW, p%QPtWeight, tolerance, testname) - - deallocate(station_eta) - deallocate(baseline_QPtN) - deallocate(baseline_QPtW) + ! -------------------------------------------------------------------------- + testname = "test_BD_TrapezoidalPointWeight_3station_2refine" - call BD_DestroyParam(p, ErrStat, ErrMsg) + ! provide three stations, unequally distributed + ! refine by factor of two - end subroutine + station_total = 3 - @test - subroutine test_BD_TrapezoidalPointWeight_3station() - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "test_BD_TrapezoidalPointWeight_3station_2refine" + call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) - ! provide three stations, unequally distributed - ! refine by factor of two + station_eta(1:station_total) = (/0., 0.25, 1./) - station_total = 3 + refine = 2 - call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) + nqp = (station_total - 1) * refine + 1 - station_eta(1:station_total) = (/0., 0.25, 1./) + p = simpleParameterType(1, 1, nqp, 0, refine) - refine = 2 + call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) + call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) - nqp = (station_total - 1)*refine + 1 + baseline_QPtN(1:nqp) = (/-1., -0.75, -0.5, 0.25, 1./) + baseline_QPtW(1:nqp) = (/0.125, 0.25, 0.125 + 0.5 * 0.75, 0.75, 0.5 * 0.75/) - p=simpleParameterType(1,1,nqp,0,refine) + call BD_TrapezoidalPointWeight(p, station_eta, station_total) - call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) - call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) - - baseline_QPtN(1:nqp) = (/ -1., -0.75, -0.5, 0.25, 1. /) - baseline_QPtW(1:nqp) = (/ 0.125, 0.25, 0.125+0.5*0.75, 0.75, 0.5*0.75/) + call check_array(error, baseline_QPtN, p%QPtN, testname, thr=tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtW, p%QPtWeight, testname, thr=tolerance); if (allocated(error)) return - call BD_TrapezoidalPointWeight(p, station_eta, station_total) - - @assertEqual(baseline_QPtN, p%QPtN, tolerance, testname) - @assertEqual(baseline_QPtW, p%QPtWeight, tolerance, testname) - - deallocate(station_eta) - deallocate(baseline_QPtN) - deallocate(baseline_QPtW) + deallocate (station_eta) + deallocate (baseline_QPtN) + deallocate (baseline_QPtW) - call BD_DestroyParam(p, ErrStat, ErrMsg) + call BD_DestroyParam(p, ErrStat, ErrMsg) - end subroutine +end subroutine end module diff --git a/modules/beamdyn/tests/test_BD_diffmtc.F90 b/modules/beamdyn/tests/test_BD_diffmtc.F90 index 6d3319d92e..fea488fe0a 100644 --- a/modules/beamdyn/tests/test_BD_diffmtc.F90 +++ b/modules/beamdyn/tests/test_BD_diffmtc.F90 @@ -1,163 +1,174 @@ module test_BD_diffmtc - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools +use BeamDyn +use NWTC_Num +use test_tools - implicit none +implicit none + +private +public :: test_BD_diffmtc_suite + +! mathematica code for calculating shape function values and derivative values +!ClearAll[p, \[Xi]j, xj, h, j, \[Xi], x, sol]; +!(* find p+1 GLL points *) +!p = 4; +!test[x_] = (1 - x^2) D[LegendreP[p, x], x]; +!\[Xi]j = Array[f, p + 1]; (* initialize list *) +!For[j = 0, j <= p, j++, +!sol = x /. FindRoot[test[x], {x, -Cos[(Pi (j))/p]}]; +! \[Xi]j[[j + 1]] = sol +!] +!h[\[Xi]_, xj_] = -(((1. - \[Xi]^2) D[ LegendreP[p, \[Xi]], \[Xi]])/( +!p (p + 1) LegendreP[p, xj] (\[Xi] - xj))); +!hd[\[Xi]_, xj_] = D[h[\[Xi], xj], \[Xi]] +!Plot[h[x, \[Xi]j[[1]]], {x, -1, 1}, PlotRange -> All] +!h[0.5, \[Xi]j[[2]]] + +contains + +!> Collect all exported unit tests +subroutine test_BD_diffmtc_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_diffmtc_2node", test_BD_diffmtc_2node), & + new_unittest("test_BD_diffmtc_5node", test_BD_diffmtc_5node) & + ] + end subroutine + +subroutine test_BD_diffmtc_2node(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - 2 node, 1 element integer :: n, i type(BD_ParameterType) :: parametertype - real(BDKi), allocatable :: test_shape(:,:), test_shapederivative(:,:) - real(BDKi), allocatable :: baseline_shape(:,:), baseline_shapederivative(:,:) + real(BDKi), allocatable :: test_shape(:, :), test_shapederivative(:, :) + real(BDKi), allocatable :: baseline_shape(:, :), baseline_shapederivative(:, :) real(BDKi), allocatable :: gll_nodes(:) integer(IntKi) :: ErrStat character :: ErrMsg character(1024) :: testname - real(BDKi) :: tolerance - - ! mathematica code for calculating shape function values and derivative values - !ClearAll[p, \[Xi]j, xj, h, j, \[Xi], x, sol]; - !(* find p+1 GLL points *) - !p = 4; - !test[x_] = (1 - x^2) D[LegendreP[p, x], x]; - !\[Xi]j = Array[f, p + 1]; (* initialize list *) - !For[j = 0, j <= p, j++, - !sol = x /. FindRoot[test[x], {x, -Cos[(Pi (j))/p]}]; - ! \[Xi]j[[j + 1]] = sol - !] - !h[\[Xi]_, xj_] = -(((1. - \[Xi]^2) D[ LegendreP[p, \[Xi]], \[Xi]])/( - !p (p + 1) LegendreP[p, xj] (\[Xi] - xj))); - !hd[\[Xi]_, xj_] = D[h[\[Xi], xj], \[Xi]] - !Plot[h[x, \[Xi]j[[1]]], {x, -1, 1}, PlotRange -> All] - !h[0.5, \[Xi]j[[2]]] -contains + ! -------------------------------------------------------------------------- + testname = "2-node element: evaluate shape/shapederivative at nodes" + + ! the shape functions should be: + ! h1(-1) = 1, h1(+1) = 0 + ! h2(-1) = 0, h2(+1) = 1 + ! + ! this is satisfied by these linear equations + ! h1(s) = 0.5*(1-s) + ! h2(s) = 0.5*(1+s) + ! therefore, + ! h1 = 0.5 + ! + ! the expected result of BD_diffmtc is + ! Shp - the shape function evaluated at the GLL nodes + ! ShpDer - the shape function derivative evaluated at the GLL nodes + ! + ! shp(1,:) = 1.0, 0.0 + ! shp(2,:) = 0.0, 1.0 + ! shpder(1,:) = -0.5, -0.5 + ! shpder(2,:) = 0.5, 0.5 + + parametertype = simpleParameterType(1, 2, 2, 0, 1) + n = parametertype%nodes_per_elem - @test - subroutine test_BD_diffmtc_2node() - ! branches to test - ! - 2 node, 1 element - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "2-node element: evaluate shape/shapederivative at nodes" - - ! the shape functions should be: - ! h1(-1) = 1, h1(+1) = 0 - ! h2(-1) = 0, h2(+1) = 1 - ! - ! this is satisfied by these linear equations - ! h1(s) = 0.5*(1-s) - ! h2(s) = 0.5*(1+s) - ! therefore, - ! h1` = -0.5 - ! h2` = 0.5 - ! - ! the expected result of BD_diffmtc is - ! Shp - the shape function evaluated at the GLL nodes - ! ShpDer - the shape function derivative evaluated at the GLL nodes - ! - ! shp(1,:) = 1.0, 0.0 - ! shp(2,:) = 0.0, 1.0 - ! shpder(1,:) = -0.5, -0.5 - ! shpder(2,:) = 0.5, 0.5 - - parametertype = simpleParameterType(1,2,2,0,1) - n = parametertype%nodes_per_elem - - call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) - call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) - - call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) - parametertype%QPtN = (/ -1.0, 1.0 /) - - call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1.0, 1.0 /) - - call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) - - call AllocAry(baseline_shape, parametertype%nodes_per_elem,parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) - call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem,parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) - baseline_shape(1,:) = (/ 1.0, 0.0 /) - baseline_shape(2,:) = (/ 0.0, 1.0 /) - baseline_shapederivative(1,:) = (/ -0.5, -0.5 /) - baseline_shapederivative(2,:) = (/ 0.5, 0.5 /) - - @assertEqual(baseline_shape, test_shape, tolerance, testname) - @assertEqual(baseline_shapederivative, test_shapederivative, tolerance, testname) - - deallocate(test_shape) - deallocate(test_shapederivative) - deallocate(gll_nodes) - deallocate(baseline_shape) - deallocate(baseline_shapederivative) - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) + call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) + + call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) + parametertype%QPtN = [-1.0, 1.0] + + call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [-1.0, 1.0] + + call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) + + call AllocAry(baseline_shape, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) + call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) + baseline_shape(1, :) = [1.0, 0.0] + baseline_shape(2, :) = [0.0, 1.0] + baseline_shapederivative(1, :) = [-0.5, -0.5] + baseline_shapederivative(2, :) = [0.5, 0.5] + + call check_array(error, baseline_shape, test_shape, testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_shapederivative, test_shapederivative, testname, tolerance); if (allocated(error)) return + + deallocate (test_shape) + deallocate (test_shapederivative) + deallocate (gll_nodes) + deallocate (baseline_shape) + deallocate (baseline_shapederivative) + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + +end subroutine + +subroutine test_BD_diffmtc_5node(error) + type(error_type), allocatable, intent(out) :: error - end subroutine - - @test - subroutine test_BD_diffmtc_5node() - ! branches to test - ! - 5 node, 1 element - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "5-node element: evaluate shape/shapederivative at nodes and at three non-node locations" - - parametertype = simpleParameterType(1,5,8,0,1) - !parametertype%nodes_per_elem = 5 - !parametertype%nqp = 8 ! testing the GLL nodes and three non-nodal locations (-0.8, 0.1, 0.4) - n = parametertype%nodes_per_elem - - call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) - call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) - - call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) - ! in following, first five points are the 4th-order GLL locations; last three points are randomly chosen off-node points - parametertype%QPtN = (/ -1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0, -0.8, 0.1, 0.4 /) - - call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0 /) - - call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) - - call AllocAry(baseline_shape, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) - call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) - - ! baseline_shape and baseline_shapederivative were calculated in Mathematica for fourth order Legendre spectral FE - - baseline_shape(1,:) = (/ 1., 0., 0., 0., 0., 0.266400000000000, 0.0329625, 0.0564/) - baseline_shape(2,:) = (/ 0., 1., 0., 0., 0., 0.855336358376291, -0.1121093731918499, -0.1746924181056723/) - baseline_shape(3,:) = (/ 0., 0., 1., 0., 0., -0.1776000000000001, 0.9669, 0.5263999999999998/) - baseline_shape(4,:) = (/ 0., 0., 0., 1., 0., 0.0854636416237095, 0.1525343731918499, 0.7234924181056726/) - baseline_shape(5,:) = (/ 0., 0., 0., 0., 1., -0.0296000000000000, -0.0402875, -0.1316/) - baseline_shapederivative(1,:) = (/-5., -1.240990253030983,0.375,-0.2590097469690172,0.5,-2.497, 0.27725, -0.1210000000000001/) - baseline_shapederivative(2,:) = (/ 6.756502488724241,0.,-1.336584577695454,0.7637626158259736,-1.410164177942427,2.144324478146486,-0.896320373697923, 0.4156426862650312/) - baseline_shapederivative(3,:) = (/-2.666666666666667, 1.74574312188794,0.,-1.74574312188794,2.666666666666667,0.5546666666666656,-0.6573333333333338, -2.069333333333333/) - baseline_shapederivative(4,:) = (/ 1.410164177942427,-0.7637626158259736, 1.336584577695454,0.,-6.756502488724241,-0.31499114481315,1.696653707031257, 1.805690647068303/) - baseline_shapederivative(5,:) = (/-0.5, 0.2590097469690172,-0.375,1.240990253030983,5.,0.1129999999999999,-0.42025, -0.03099999999999978/) - - @assertEqual(baseline_shape, test_shape, tolerance, testname) - @assertEqual(baseline_shapederivative, test_shapederivative, tolerance, testname) - - deallocate(test_shape) - deallocate(test_shapederivative) - deallocate(gll_nodes) - deallocate(baseline_shape) - deallocate(baseline_shapederivative) - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) - - end subroutine + ! branches to test + ! - 5 node, 1 element + + integer :: n, i + type(BD_ParameterType) :: parametertype + real(BDKi), allocatable :: test_shape(:, :), test_shapederivative(:, :) + real(BDKi), allocatable :: baseline_shape(:, :), baseline_shapederivative(:, :) + real(BDKi), allocatable :: gll_nodes(:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "5-node element: evaluate shape/shapederivative at nodes and at three non-node locations" + + parametertype = simpleParameterType(1, 5, 8, 0, 1) + !parametertype%nodes_per_elem = 5 + !parametertype%nqp = 8 ! testing the GLL nodes and three non-nodal locations (-0.8, 0.1, 0.4) + n = parametertype%nodes_per_elem + + call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) + call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) + + call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) + ! in following, first five points are the 4th-order GLL locations; last three points are randomly chosen off-node points + parametertype%QPtN = [-1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0, -0.8, 0.1, 0.4] + + call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [-1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0] + + call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) + + call AllocAry(baseline_shape, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) + call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) + + ! baseline_shape and baseline_shapederivative were calculated in Mathematica for fourth order Legendre spectral FE + + baseline_shape(1, :) = [1., 0., 0., 0., 0., 0.266400000000000, 0.0329625, 0.0564] + baseline_shape(2, :) = [0., 1., 0., 0., 0., 0.855336358376291, -0.1121093731918499, -0.1746924181056723] + baseline_shape(3, :) = [0., 0., 1., 0., 0., -0.1776000000000001, 0.9669, 0.5263999999999998] + baseline_shape(4, :) = [0., 0., 0., 1., 0., 0.0854636416237095, 0.1525343731918499, 0.7234924181056726] + baseline_shape(5, :) = [0., 0., 0., 0., 1., -0.0296000000000000, -0.0402875, -0.1316] + baseline_shapederivative(1, :) = [-5., -1.240990253030983, 0.375, -0.2590097469690172, 0.5, -2.497, 0.27725, -0.1210000000000001] + baseline_shapederivative(2, :) = [6.756502488724241, 0., -1.336584577695454, 0.7637626158259736, -1.410164177942427, 2.144324478146486, -0.896320373697923, 0.4156426862650312] + baseline_shapederivative(3, :) = [-2.666666666666667, 1.74574312188794, 0., -1.74574312188794, 2.666666666666667, 0.5546666666666656, -0.6573333333333338, -2.069333333333333] + baseline_shapederivative(4, :) = [1.410164177942427, -0.7637626158259736, 1.336584577695454, 0., -6.756502488724241, -0.31499114481315, 1.696653707031257, 1.805690647068303] + baseline_shapederivative(5, :) = [-0.5, 0.2590097469690172, -0.375, 1.240990253030983, 5., 0.1129999999999999, -0.42025, -0.03099999999999978] + + call check_array(error, baseline_shape, test_shape, testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_shapederivative, test_shapederivative, testname, tolerance); if (allocated(error)) return + + deallocate (test_shape) + deallocate (test_shapederivative) + deallocate (gll_nodes) + deallocate (baseline_shape) + deallocate (baseline_shapederivative) + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + +end subroutine + end module diff --git a/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 b/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 deleted file mode 100644 index 669d132e58..0000000000 --- a/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 +++ /dev/null @@ -1,36 +0,0 @@ -@test -subroutine test_ExtractRelativeRotation() - ! this is actually an integration test not a unit test... - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3) :: rr - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - type(BD_ParameterType) :: parametertype - type(BD_OtherStateType) :: otherstate - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - - otherstate = simpleOtherState() - parametertype = simpleParameterType(1,16,16,0,0) - - call ExtractRelativeRotation(identity(), parametertype, otherstate, rr, ErrStat, ErrMsg) - - @assertEqual((/ 0.0, 0.0, 0.0 /), rr, tolerance, testname) -end subroutine diff --git a/modules/beamdyn/tests/test_InitializeNodalLocations.F90 b/modules/beamdyn/tests/test_InitializeNodalLocations.F90 deleted file mode 100644 index 9c488583c7..0000000000 --- a/modules/beamdyn/tests/test_InitializeNodalLocations.F90 +++ /dev/null @@ -1,134 +0,0 @@ -module test_InitializeNodalLocations - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - type(BD_ParameterType) :: p - - integer(IntKi) :: i ! do loop - - integer(IntKi) :: member_total - integer(IntKi), allocatable :: kp_member(:) - real(BDKi), allocatable :: kp_coordinate(:,:) - - real(BDKi), allocatable :: baseline_uuN0(:,:,:) - real(BDKi), allocatable :: baseline_tangent(:,:,:) - real(BDKi), allocatable :: baseline_twist(:,:) - real(BDKi), allocatable :: gll(:) - - real(BDKi) :: cc(3) - - integer(IntKi) :: np ! number of points defining reference line - - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - -contains - - @test - subroutine test_InitializeNodalLocations_np5_p6() - - ! test problem where reference line is defined by 1 member, 5 keypoints, - ! and we fit a 6th order LSFE - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-13 - - ! -------------------------------------------------------------------------- - testname = "test_InitializeNodalLocations_1m_kp5_p6" - - member_total = 1 - - np = 5 ! five points defining the reference line - p=simpleParameterType(1,7,3,0,1) !simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) - - p%dof_node = 6 - - call AllocAry(kp_member, member_total, "kp_member",ErrStat, ErrMsg) - call AllocAry(gll,p%nodes_per_elem, "gll",ErrStat, ErrMsg) - call AllocAry(baseline_uuN0, p%dof_node, p%nodes_per_elem, p%elem_total, "baseline_uuN0",ErrStat, ErrMsg) - - call AllocAry(baseline_tangent, 3, p%nodes_per_elem, p%elem_total, "baseline_tangent", ErrStat, ErrMsg) - call AllocAry(baseline_twist, p%nodes_per_elem, p%elem_total, "baseline_twist", ErrStat, ErrMsg) - - ! remove the following once the routine moves to least squares - - CALL AllocAry(p%segment_eta,np-1,'segment length ratio array',ErrStat,ErrMsg) - - kp_member(1) = np ! one member defined by 5 points - - call AllocAry(kp_coordinate, kp_member(1), 4, "kp_coordinate",ErrStat, ErrMsg) - - kp_coordinate(1,:) = (/ 0.,0.,0.,0. /) - kp_coordinate(2,:) = (/ 0.2421875,0.3125,1.25,5.625 /) - kp_coordinate(3,:) = (/ 0.375,1.,2.5,22.5/) - kp_coordinate(4,:) = (/ 0.1171875,2.0625,3.75, 50.625 /) - kp_coordinate(5,:) = (/ -1.,3.5,5., 90. /) - - gll(:) = (/ -1., -0.8302238962785669, -0.46884879347071423, 0., 0.46884879347071423, 0.8302238962785669, 1. /) - - baseline_uuN0 = 0. - - ! following calculated in mathematica - baseline_uuN0(1:3,1,1) = (/ 0.,0.,0. /) - baseline_uuN0(1:3,2,1) = (/ 0.0847841995263206,0.06406196997648083,0.4244402593035813 /) - baseline_uuN0(1:3,3,1) = (/ 0.2556265283202704,0.3443790047804582,1.327878016323214 /) - baseline_uuN0(1:3,4,1) = (/ 0.375,1.,2.5 /) - baseline_uuN0(1:3,5,1) = (/ 0.152564565773068,1.985349781927959,3.672121983676785 /) - baseline_uuN0(1:3,6,1) = (/ -0.4874656517463806,2.969845606951464,4.575559740696413 /) - baseline_uuN0(1:3,7,1) = (/ -1.,3.5,5. /) - - baseline_tangent(1:3,1,1) = (/ 0.1951800145897074,0.0975900072948519,0.975900072948533 /) - baseline_tangent(1:3,2,1) = (/ 0.1914764728687931,0.1942130285347349,0.962090463462295 /) - baseline_tangent(1:3,3,1) = (/ 0.1549438849532919,0.3815415434641369,0.911272979477931 /) - baseline_tangent(1:3,4,1) = (/ 0., 0.5734623443633284,0.81923192051904 /) - baseline_tangent(1:3,5,1) = (/ -0.2957782328585355,0.6690666276575518,0.6818101529913093 /) - baseline_tangent(1:3,6,1) = (/ -0.5494018213496115,0.6414840856724742,0.535402471535834 /) - baseline_tangent(1:3,7,1) = (/ -0.6492344540642337,0.6028605644882184,0.4637388957601716 /) - - baseline_twist(1,1) = 0. - baseline_twist(2,1) = 0.6485383213836768 - baseline_twist(3,1) = 6.347736094444107 - baseline_twist(4,1) = 22.50000000000001 - baseline_twist(5,1) = 48.54412750680838 - baseline_twist(6,1) = 75.36868898645466 - baseline_twist(7,1) = 90. - - ! here we're using the BD_ComputeIniNodalCrv to construct the rotation parameters; this is what is used in - ! BeamDyn; I do not want to rely on this routine and would rather calculate externally - do i = 1, 7 - CALL BD_ComputeIniNodalCrv(baseline_tangent(1:3,i,1), baseline_twist(i,1), cc, ErrStat, ErrMsg) - baseline_uuN0(4:6,i,1) = cc - enddo - - ! remove after reworking fit; dropping spline in favor of lease squares; p%SP_Coef is required in original spline fit implementation - !call ComputeSplineCoeffs(member_total, np, kp_member, kp_coordinate, p%SP_Coef, ErrStat, ErrMsg) - - call InitializeNodalLocations(member_total, kp_member, kp_coordinate, p, GLL, ErrStat,ErrMsg) - - !do i = 1, 7 - ! write(*,*) i, baseline_uuN0(4,i,1), baseline_uuN0(5,i,1), baseline_uuN0(6,i,1), p%uuN0(4,i,1), p%uuN0(5,i,1), p%uuN0(6,i,1) - !enddo - - @assertEqual(baseline_uuN0, p%uuN0, tolerance, testname) - - deallocate(kp_member) - deallocate(kp_coordinate) - deallocate(gll) - deallocate(baseline_uuN0) - deallocate(baseline_tangent) - deallocate(baseline_twist) - - call BD_DestroyParam(p, ErrStat, ErrMsg) - - end subroutine - -end module diff --git a/modules/beamdyn/tests/test_tools.F90 b/modules/beamdyn/tests/test_tools.F90 index 1f64ec584e..f8c520fdc0 100644 --- a/modules/beamdyn/tests/test_tools.F90 +++ b/modules/beamdyn/tests/test_tools.F90 @@ -1,285 +1,394 @@ module test_tools - + use BeamDyn_Types +use BeamDyn_Subs +use testdrive, only: new_unittest, unittest_type, error_type, check implicit none - -contains - - subroutine calcWMParameters(params, angle, n) - use BeamDyn_Subs - implicit none - - real(BDKi), intent( out), dimension(3) :: params - real(BDKi), intent(in ) :: angle - real(BDKi), intent(in ), dimension(3) :: n - - params = 4.0 * tan(angle/4.0) * n - end subroutine - - function calcRotationMatrix(angle, axis) - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(3,3) :: calcRotationMatrix - real(BDKi), intent(in) :: angle - real(BDKi), intent(in), dimension(3) :: axis - real(BDKi), dimension(3,3) :: r - - r(1,:) = (/ cos(angle) + (1-cos(angle))*axis(1)**2, axis(1)*axis(2)*(1-cos(angle)) - axis(3)*sin(angle), axis(1)*axis(3)*(1-cos(angle)) + axis(2)*sin(angle) /) - r(2,:) = (/ axis(2)*axis(1)*(1-cos(angle)) + axis(3)*sin(angle), cos(angle) + (1-cos(angle))*axis(2)**2, axis(2)*axis(3)*(1-cos(angle)) - axis(1)*sin(angle) /) - r(3,:) = (/ axis(3)*axis(1)*(1-cos(angle)) - axis(2)*sin(angle), axis(3)*axis(2)*(1-cos(angle)) + axis(1)*sin(angle), cos(angle) + (1-cos(angle))*axis(3)**2 /) - - calcRotationMatrix = r - - end function - - function identity() - use BeamDyn_Subs - implicit none - - real(BDKi) :: identity(3,3) - - identity(1,:) = (/ 1.0, 0.0, 0.0 /) - identity(2,:) = (/ 0.0, 1.0, 0.0 /) - identity(3,:) = (/ 0.0, 0.0, 1.0 /) - end function - - function RonXAxis(angle) - use BeamDyn_Subs - implicit none - - real(BDKi) :: angle, r(3,3), RonXAxis(3,3) - - r(1,:) = (/ 1.0_BDKi, 0.0_BDKi, 0.0_BDKi /) - r(2,:) = (/ 0.0_BDKi, cos(angle), -sin(angle) /) - r(3,:) = (/ 0.0_BDKi, sin(angle), cos(angle) /) - RonXAxis = r - end function - - function getMassMatrix() - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(6,6) :: getMassMatrix - getMassMatrix(1,:) = (/ 1.E0, 0.0, 0.0, 0.0, 0.0, -0.5 /) - getMassMatrix(2,:) = (/ 0.0, 1.E0, 0.0, 0.0, 0.0, 0.5 /) - getMassMatrix(3,:) = (/ 0.0, 0.0, 1.E0, 0.5, -0.5, 0.0 /) - getMassMatrix(4,:) = (/ 0.0, 0.0, 0.5, 1.E0, 0.0, 0.0 /) - getMassMatrix(5,:) = (/ 0.0, 0.0, -0.5, 0.0, 1.E0, 0.0 /) - getMassMatrix(6,:) = (/ -0.5, 0.5, 0.0, 0.0, 0.0, 2.E0 /) - end function - - function getStiffnessMatrix() - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(6,6) :: getStiffnessMatrix - getStiffnessMatrix(1,:) = (/ 1.E4, 0.0, 0.0, 0.0, 0.0, 0.0 /) - getStiffnessMatrix(2,:) = (/ 0.0, 1.E4, 0.0, 0.0, 0.0, 0.0 /) - getStiffnessMatrix(3,:) = (/ 0.0, 0.0, 1.E4, 0.0, 0.0, 0.0 /) - getStiffnessMatrix(4,:) = (/ 0.0, 0.0, 0.0, 1.E2, 0.0, 0.0 /) - getStiffnessMatrix(5,:) = (/ 0.0, 0.0, 0.0, 0.0, 1.E2, 0.0 /) - getStiffnessMatrix(6,:) = (/ 0.0, 0.0, 0.0, 0.0, 0.0, 200.E0 /) - end function - - function getGravityInZ() - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(3) :: getGravityInZ - getGravityInZ = (/ 0.0, 0.0, -9.806 /) - end function - - type(BD_OtherStateType) function simpleOtherState() result(otherstate) - ! fixed size arrays - otherstate%Glb_crv = (/ 0.0, 0.0, 0.0 /) - otherstate%GlbRot = identity() - end function - type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) RESULT(p) - - integer, intent(in ) :: elem_total - integer, intent(in ) :: nodes_per_elem - integer, intent(in ) :: nqp - integer, intent(in ) :: qp_indx_offset - integer, intent(in ) :: refine - - integer :: i, j - integer :: ErrStat - character(1024) :: ErrMsg - - p%elem_total = elem_total - p%nodes_per_elem = nodes_per_elem - p%nqp = nqp - p%qp_indx_offset = qp_indx_offset - p%refine = refine - - p%dof_node = 6 - - ! allocate arrays - call AllocAry(p%qp%mmm, p%nqp, p%elem_total, 'qp_mmm', ErrStat, ErrMsg) - call AllocAry(p%qp%mEta, 3, p%nqp, p%elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) - call AllocAry(p%Mass0_QP, 6, 6, p%nqp*p%elem_total, 'Mass0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices - call AllocAry(p%Stif0_QP, 6, 6, p%nqp*p%elem_total, 'Stif0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices - call AllocAry(p%QPtw_Shp_Shp_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Shp_Jac', ErrStat, ErrMsg) - call AllocAry(p%QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) - call AllocAry(p%QPtw_Shp_ShpDer, p%nqp, p%nodes_per_elem, p%nodes_per_elem, 'QPtw_Shp_ShpDer', ErrStat, ErrMsg) - call AllocAry(p%QPtw_Shp_Jac, p%nqp, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Jac', ErrStat, ErrMsg) - call AllocAry(p%Shp, p%nodes_per_elem, p%nqp, 'Shp', ErrStat, ErrMsg) - call AllocAry(p%ShpDer, p%nodes_per_elem, p%nqp, 'ShpDer', ErrStat, ErrMsg) - call AllocAry(p%QPtN, p%nqp, 'QPtN', ErrStat, ErrMsg) - call AllocAry(p%QPtWeight, p%nqp, 'QPtWeight', ErrStat, ErrMsg) - call AllocAry(p%QPtw_ShpDer, p%nqp, p%nodes_per_elem, 'QPtw_ShpDer', ErrStat, ErrMsg) - call AllocAry(p%Jacobian, p%nqp, p%elem_total, 'Jacobian', ErrStat, ErrMsg) - call AllocAry(p%uuN0, p%dof_node, p%nodes_per_elem, p%elem_total,'uuN0', ErrStat, ErrMsg) - - call AllocAry(p%uu0, p%dof_node, p%nqp, p%elem_total,'uu0', ErrStat, ErrMsg) - call AllocAry(p%E10, p%dof_node/2, p%nqp, p%elem_total,'E10', ErrStat, ErrMsg) - call AllocAry(p%rrN0, p%dof_node/2, p%nodes_per_elem, p%elem_total,'rrN0', ErrStat, ErrMsg) - - CALL AllocAry(p%node_elem_idx,p%elem_total,2,'start and end node numbers of elements in p%node_total sized arrays',ErrStat,ErrMsg) - - ! construct arrays - p%qp%mmm = 1.0 - - DO i=1,p%elem_total - p%node_elem_idx(i,1) = (i-1)*(p%nodes_per_elem-1) + 1 ! First node in element - p%node_elem_idx(i,2) = i *(p%nodes_per_elem-1) + 1 ! Last node in element - ENDDO - - do j=1, p%elem_total - do i=1, p%nqp - p%qp%mEta(:,i,j) = (/ 0.0, 0.0, 0.0 /) - p%Mass0_QP(:,:,(i-1)*p%elem_total+j) = getMassMatrix() + +interface check_array + module procedure check_array_R4_Rank1, check_array_R8_Rank1, & + check_array_R4_Rank2, check_array_R8_Rank2, & + check_array_R4_Rank3, check_array_R8_Rank3, & + check_array_R4_Rank4, check_array_R8_Rank4 +end interface + +real(DbKi), parameter :: tolerance = 1.0e-13_BDKi + +contains + +subroutine check_array_R4_Rank1(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:), A2(:) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i + do i = 1, size(A1) + call check(error, A1(i), A2(i), message=trim('A('//trim(Num2LStr(i))//') '//message), thr=thr) + if (allocated(error)) return + end do +end subroutine + +subroutine check_array_R8_Rank1(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:), A2(:) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i + do i = 1, size(A1) + call check(error, A1(i), A2(i), message=trim('A('//trim(Num2LStr(i))//') '//message), thr=thr) + if (allocated(error)) return + end do +end subroutine + +subroutine check_array_R4_Rank2(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:, :), A2(:, :) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + call check(error, A1(i, j), A2(i, j), message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do +end subroutine + +subroutine check_array_R8_Rank2(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:, :), A2(:, :) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + call check(error, A1(i, j), A2(i, j), message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do +end subroutine + +subroutine check_array_R4_Rank3(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:, :, :), A2(:, :, :) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + call check(error, A1(i, j, k), A2(i, j, k), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do + end do +end subroutine + +subroutine check_array_R8_Rank3(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:, :, :), A2(:, :, :) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + call check(error, A1(i, j, k), A2(i, j, k), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do + end do +end subroutine + +subroutine check_array_R4_Rank4(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:, :, :, :), A2(:, :, :, :) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k, m + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + do m = 1, size(A1, 4) + call check(error, A1(i, j, k, m), A2(i, j, k, m), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//','//trim(Num2LStr(m))//') '//message), thr=thr) + if (allocated(error)) return end do - end do - - end function - - type(BD_MiscVarType) function simpleMiscVarType(nqp, dof_node, elem_total, nodes_per_elem) RESULT(m) - - integer, intent(in) :: nqp, elem_total, dof_node, nodes_per_elem - integer :: i, j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - - ! fixed size arrays - - ! allocate arrays - call AllocAry(m%qp%Fg, 6, nqp, elem_total, 'qp_Fg', ErrStat, ErrMsg) - call AllocAry(m%qp%RR0, 3, 3, nqp, elem_total, 'qp_RR0', ErrStat, ErrMsg) - call AllocAry(m%qp%RR0mEta, 3, nqp, elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) - call AllocAry(m%DistrLoad_QP, 6, nqp, elem_total, 'DistrLoad_QP', ErrStat, ErrMsg) - - CALL AllocAry(m%qp%uuu, dof_node ,nqp,elem_total, 'm%qp%uuu displacement at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%uup, dof_node/2,nqp,elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat,ErrMsg) - - ! E1, kappa -- used in force calculations - CALL AllocAry(m%qp%E1, dof_node/2,nqp,elem_total, 'm%qp%E1 at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%kappa, dof_node/2,nqp,elem_total, 'm%qp%kappa at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%RR0, 3,3, nqp,elem_total, 'm%qp%RR0 at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%Stif, 6,6, nqp,elem_total, 'm%qp%Stif at quadrature point',ErrStat,ErrMsg) - - CALL AllocAry(m%qp%RR0mEta, dof_node/2, nqp, elem_total, 'm%qp%RRo times p%qp%mEta at quadrature point',ErrStat,ErrMsg) - call AllocAry(m%qp%rho, 3, 3, nqp, elem_total, 'qp_rho', ErrStat, ErrMsg) - CALL AllocAry(m%qp%betaC, 6,6, nqp,elem_total, 'm%qp%betaC at quadrature point',ErrStat,ErrMsg) - - CALL AllocAry(m%qp%Fc, dof_node, nqp, elem_total, 'm%qp%Fc at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%Fd, dof_node, nqp, elem_total, 'm%qp%Fd at quadrature point',ErrStat,ErrMsg) - - CALL AllocAry(m%Nrrr, dof_node/2, nodes_per_elem, elem_total,'Nrrr: rotation parameters relative to root', ErrStat,ErrMsg) - - ! construct arrays - do j=1, elem_total - do i=1, nqp - m%qp%RR0(:,:,i,j) = identity() - m%qp%RR0mEta(:,i,j) = (/ 0.0, 0.0, 0.0 /) + end do + end do + end do +end subroutine + +subroutine check_array_R8_Rank4(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:, :, :, :), A2(:, :, :, :) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k, m + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + do m = 1, size(A1, 4) + call check(error, A1(i, j, k, m), A2(i, j, k, m), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//','//trim(Num2LStr(m))//') '//message), thr=thr) + if (allocated(error)) return end do - end do - - end function - - type(BD_InputType) function simpleInputType(nqp, nelem) RESULT(i) - - integer, intent(in) :: nqp, nelem - integer :: j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - - ! fixed size arrays - - ! allocate arrays - call AllocAry(i%DistrLoad%Force, 3, nqp*nelem, 'DistrLoadForce', ErrStat, ErrMsg) - call AllocAry(i%DistrLoad%Moment, 3, nqp*nelem, 'DistrLoadMoment', ErrStat, ErrMsg) - - ! construct arrays - do j = 1, nqp*nelem - i%DistrLoad%Force(:,j) = (/ 3*(j-1)+1, 3*(j-1)+2, 3*(j-1)+3 /) - i%DistrLoad%Moment(:,j) = (/ -3*(j-1)-1, -3*(j-1)-2, -3*(j-1)-3 /) - end do - - end function - - type(BD_InputFile) function simpleInputFile() RESULT(i) - - integer :: j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - i%QuasiStaticInit = .false. ! - - - "QuasiStaticInit" - - i%member_total = 1 ! - - - "Total number of members" - - i%kp_total = 3 ! - - - "Total number of key point" - - i%order_elem = 15 ! - - - "Order of interpolation (basis) function" - - i%NRMax = 10 ! - - - "Max number of iterations in Newton Ralphson algorithm" - - i%quadrature = 1 ! - - - "Quadrature: 1: Gauss; 2: Trapezoidal" - - i%n_fact = 5 ! - - - "Factorization frequency" - - i%refine = 1 ! - - - "FE mesh refinement factor for trapezoidal quadrature" - - i%rhoinf = 0.0 ! - - - "Numerical damping parameter for generalized-alpha integrator" - - i%DTBeam = 2E-03 ! - - - "Time interval for BeamDyn calculations {or default} (s)" - - i%UsePitchAct = .FALSE. ! - - - "Whether to use a pitch actuator inside BeamDyn" (flag) - i%pitchJ = 0.0 ! - - - "Pitch actuator inertia" (kg-m^2) - i%pitchK = 0.0 ! - - - "Pitch actuator stiffness" (kg-m^2/s^2) - i%pitchC = 0.0 ! - - - "Pitch actuator damping" - (kg-m^2/s) - i%Echo = .TRUE. ! - - - "Echo" - i%NNodeOuts = 1 ! - - - "Number of node outputs [0 - 9]" - - i%OutNd = 1 ! {9} - - "Nodes whose values will be output" - - i%SumPrint = .TRUE. ! - - - "Print summary data to file? (.sum)" - - i%OutFmt = "ES16.8E2" ! - - - "Format specifier" - - - ! fixed size arrays - i%kp_member = (/ 3 /) !{:} - - "Number of key points in each member" - - i%OutList = (/ "TipTDxr, TipTDyr, TipTDzr", "TipRDxr, TipRDyr, TipRDzr" /) ! {:} - - "List of user-requested output channels" - - - ! allocate arrays - call AllocAry(i%kp_coordinate, 3, 4, 'kp_coordinate', ErrStat, ErrMsg) - - ! construct arrays - i%kp_coordinate(1,:) = (/ 0.000000, 0.000000, 0.0000, 0.00000 /) ! {:}{:} - - "Key point coordinates array" - - i%kp_coordinate(2,:) = (/ 0.000000, 0.000000, 5.0000, 0.00000 /) - i%kp_coordinate(3,:) = (/ 0.000000, 0.000000, 10.0000, 0.00000 /) - - end function - - type(BD_ContinuousStateType) function simpleContinuousStateType(node_total, nodes_per_elem, elem_total) RESULT(x) - - integer, intent(in) :: node_total,nodes_per_elem, elem_total - integer :: j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - - ! fixed size arrays - - ! allocate arrays - call AllocAry(x%q, 6, node_total, 'Displacement/Rotation Nodal DOF', ErrStat, ErrMsg) - call AllocAry(x%dqdt, 6, node_total, 'Velocity Nodal DOF', ErrStat, ErrMsg) - - end function - + end do + end do + end do +end subroutine + +subroutine calcWMParameters(params, angle, n) + real(BDKi), intent(out), dimension(3) :: params + real(BDKi), intent(in) :: angle + real(BDKi), intent(in), dimension(3) :: n + + params = 4.0 * tan(angle / 4.0) * n +end subroutine + +function calcRotationMatrix(angle, axis) + real(BDKi), dimension(3, 3) :: calcRotationMatrix + real(BDKi), intent(in) :: angle + real(BDKi), intent(in), dimension(3) :: axis + real(BDKi), dimension(3, 3) :: r + + r(1, :) = [cos(angle) + (1 - cos(angle)) * axis(1)**2, axis(1) * axis(2) * (1 - cos(angle)) - axis(3) * sin(angle), axis(1) * axis(3) * (1 - cos(angle)) + axis(2) * sin(angle)] + r(2, :) = [axis(2) * axis(1) * (1 - cos(angle)) + axis(3) * sin(angle), cos(angle) + (1 - cos(angle)) * axis(2)**2, axis(2) * axis(3) * (1 - cos(angle)) - axis(1) * sin(angle)] + r(3, :) = [axis(3) * axis(1) * (1 - cos(angle)) - axis(2) * sin(angle), axis(3) * axis(2) * (1 - cos(angle)) + axis(1) * sin(angle), cos(angle) + (1 - cos(angle)) * axis(3)**2] + + calcRotationMatrix = r + +end function + +function identity() + real(BDKi) :: identity(3, 3) + + identity(1, :) = [1.0, 0.0, 0.0] + identity(2, :) = [0.0, 1.0, 0.0] + identity(3, :) = [0.0, 0.0, 1.0] +end function + +function RonXAxis(angle) + real(BDKi) :: angle, r(3, 3), RonXAxis(3, 3) + + r(1, :) = [1.0_BDKi, 0.0_BDKi, 0.0_BDKi] + r(2, :) = [0.0_BDKi, cos(angle), -sin(angle)] + r(3, :) = [0.0_BDKi, sin(angle), cos(angle)] + RonXAxis = r +end function + +function getMassMatrix() + real(BDKi), dimension(6, 6) :: getMassMatrix + getMassMatrix(1, :) = [1.E0, 0.0, 0.0, 0.0, 0.0, -0.5] + getMassMatrix(2, :) = [0.0, 1.E0, 0.0, 0.0, 0.0, 0.5] + getMassMatrix(3, :) = [0.0, 0.0, 1.E0, 0.5, -0.5, 0.0] + getMassMatrix(4, :) = [0.0, 0.0, 0.5, 1.E0, 0.0, 0.0] + getMassMatrix(5, :) = [0.0, 0.0, -0.5, 0.0, 1.E0, 0.0] + getMassMatrix(6, :) = [-0.5, 0.5, 0.0, 0.0, 0.0, 2.E0] +end function + +function getStiffnessMatrix() + real(BDKi), dimension(6, 6) :: getStiffnessMatrix + getStiffnessMatrix(1, :) = [1.E4, 0.0, 0.0, 0.0, 0.0, 0.0] + getStiffnessMatrix(2, :) = [0.0, 1.E4, 0.0, 0.0, 0.0, 0.0] + getStiffnessMatrix(3, :) = [0.0, 0.0, 1.E4, 0.0, 0.0, 0.0] + getStiffnessMatrix(4, :) = [0.0, 0.0, 0.0, 1.E2, 0.0, 0.0] + getStiffnessMatrix(5, :) = [0.0, 0.0, 0.0, 0.0, 1.E2, 0.0] + getStiffnessMatrix(6, :) = [0.0, 0.0, 0.0, 0.0, 0.0, 200.E0] +end function + +function getGravityInZ() + real(BDKi), dimension(3) :: getGravityInZ + getGravityInZ = [0.0, 0.0, -9.806] +end function + +type(BD_OtherStateType) function simpleOtherState() result(otherstate) + ! fixed size arrays + otherstate%Glb_crv = [0.0, 0.0, 0.0] + otherstate%GlbRot = identity() +end function +type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) result(p) + integer, intent(in) :: elem_total + integer, intent(in) :: nodes_per_elem + integer, intent(in) :: nqp + integer, intent(in) :: qp_indx_offset + integer, intent(in) :: refine + + integer :: i, j + integer :: ErrStat + character(1024) :: ErrMsg + + p%elem_total = elem_total + p%nodes_per_elem = nodes_per_elem + p%nqp = nqp + p%qp_indx_offset = qp_indx_offset + p%refine = refine + + p%dof_node = 6 + + ! allocate arrays + call AllocAry(p%qp%mmm, p%nqp, p%elem_total, 'qp_mmm', ErrStat, ErrMsg) + call AllocAry(p%qp%mEta, 3, p%nqp, p%elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) + call AllocAry(p%Mass0_QP, 6, 6, p%nqp * p%elem_total, 'Mass0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices + call AllocAry(p%Stif0_QP, 6, 6, p%nqp * p%elem_total, 'Stif0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices + call AllocAry(p%QPtw_Shp_Shp_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Shp_Jac', ErrStat, ErrMsg) + call AllocAry(p%QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) + call AllocAry(p%QPtw_Shp_ShpDer, p%nqp, p%nodes_per_elem, p%nodes_per_elem, 'QPtw_Shp_ShpDer', ErrStat, ErrMsg) + call AllocAry(p%QPtw_Shp_Jac, p%nqp, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Jac', ErrStat, ErrMsg) + call AllocAry(p%Shp, p%nodes_per_elem, p%nqp, 'Shp', ErrStat, ErrMsg) + call AllocAry(p%ShpDer, p%nodes_per_elem, p%nqp, 'ShpDer', ErrStat, ErrMsg) + call AllocAry(p%QPtN, p%nqp, 'QPtN', ErrStat, ErrMsg) + call AllocAry(p%QPtWeight, p%nqp, 'QPtWeight', ErrStat, ErrMsg) + call AllocAry(p%QPtw_ShpDer, p%nqp, p%nodes_per_elem, 'QPtw_ShpDer', ErrStat, ErrMsg) + call AllocAry(p%Jacobian, p%nqp, p%elem_total, 'Jacobian', ErrStat, ErrMsg) + call AllocAry(p%uuN0, p%dof_node, p%nodes_per_elem, p%elem_total, 'uuN0', ErrStat, ErrMsg) + + call AllocAry(p%uu0, p%dof_node, p%nqp, p%elem_total, 'uu0', ErrStat, ErrMsg) + call AllocAry(p%E10, p%dof_node / 2, p%nqp, p%elem_total, 'E10', ErrStat, ErrMsg) + call AllocAry(p%rrN0, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'rrN0', ErrStat, ErrMsg) + + call AllocAry(p%node_elem_idx, p%elem_total, 2, 'start and end node numbers of elements in p%node_total sized arrays', ErrStat, ErrMsg) + + ! construct arrays + p%qp%mmm = 1.0 + + do i = 1, p%elem_total + p%node_elem_idx(i, 1) = (i - 1) * (p%nodes_per_elem - 1) + 1 ! First node in element + p%node_elem_idx(i, 2) = i * (p%nodes_per_elem - 1) + 1 ! Last node in element + end do + + do j = 1, p%elem_total + do i = 1, p%nqp + p%qp%mEta(:, i, j) = [0.0, 0.0, 0.0] + p%Mass0_QP(:, :, (i - 1) * p%elem_total + j) = getMassMatrix() + end do + end do + +end function + +type(BD_MiscVarType) function simpleMiscVarType(nqp, dof_node, elem_total, nodes_per_elem) result(m) + integer, intent(in) :: nqp, elem_total, dof_node, nodes_per_elem + integer :: i, j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + + ! fixed size arrays + + ! allocate arrays + call AllocAry(m%qp%Fg, 6, nqp, elem_total, 'qp_Fg', ErrStat, ErrMsg) + call AllocAry(m%qp%RR0, 3, 3, nqp, elem_total, 'qp_RR0', ErrStat, ErrMsg) + call AllocAry(m%qp%RR0mEta, 3, nqp, elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) + call AllocAry(m%DistrLoad_QP, 6, nqp, elem_total, 'DistrLoad_QP', ErrStat, ErrMsg) + + call AllocAry(m%qp%uuu, dof_node, nqp, elem_total, 'm%qp%uuu displacement at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%uup, dof_node / 2, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) + + ! E1, kappa -- used in force calculations + call AllocAry(m%qp%E1, dof_node / 2, nqp, elem_total, 'm%qp%E1 at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%kappa, dof_node / 2, nqp, elem_total, 'm%qp%kappa at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%RR0, 3, 3, nqp, elem_total, 'm%qp%RR0 at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%Stif, 6, 6, nqp, elem_total, 'm%qp%Stif at quadrature point', ErrStat, ErrMsg) + + call AllocAry(m%qp%RR0mEta, dof_node / 2, nqp, elem_total, 'm%qp%RRo times p%qp%mEta at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%rho, 3, 3, nqp, elem_total, 'qp_rho', ErrStat, ErrMsg) + call AllocAry(m%qp%betaC, 6, 6, nqp, elem_total, 'm%qp%betaC at quadrature point', ErrStat, ErrMsg) + + call AllocAry(m%qp%Fc, dof_node, nqp, elem_total, 'm%qp%Fc at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%Fd, dof_node, nqp, elem_total, 'm%qp%Fd at quadrature point', ErrStat, ErrMsg) + + call AllocAry(m%Nrrr, dof_node / 2, nodes_per_elem, elem_total, 'Nrrr: rotation parameters relative to root', ErrStat, ErrMsg) + + ! construct arrays + do j = 1, elem_total + do i = 1, nqp + m%qp%RR0(:, :, i, j) = identity() + m%qp%RR0mEta(:, i, j) = [0.0, 0.0, 0.0] + end do + end do + +end function + +type(BD_InputType) function simpleInputType(nqp, nelem) result(i) + integer, intent(in) :: nqp, nelem + integer :: j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + + ! fixed size arrays + + ! allocate arrays + call AllocAry(i%DistrLoad%Force, 3, nqp * nelem, 'DistrLoadForce', ErrStat, ErrMsg) + call AllocAry(i%DistrLoad%Moment, 3, nqp * nelem, 'DistrLoadMoment', ErrStat, ErrMsg) + + ! construct arrays + do j = 1, nqp * nelem + i%DistrLoad%Force(:, j) = [3 * (j - 1) + 1, 3 * (j - 1) + 2, 3 * (j - 1) + 3] + i%DistrLoad%Moment(:, j) = [-3 * (j - 1) - 1, -3 * (j - 1) - 2, -3 * (j - 1) - 3] + end do + +end function + +type(BD_InputFile) function simpleInputFile() result(i) + integer :: j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + i%QuasiStaticInit = .false. ! - - - "QuasiStaticInit" - + i%member_total = 1 ! - - - "Total number of members" - + i%kp_total = 3 ! - - - "Total number of key point" - + i%order_elem = 15 ! - - - "Order of interpolation (basis) function" - + i%NRMax = 10 ! - - - "Max number of iterations in Newton Ralphson algorithm" - + i%quadrature = 1 ! - - - "Quadrature: 1: Gauss; 2: Trapezoidal" - + i%n_fact = 5 ! - - - "Factorization frequency" - + i%refine = 1 ! - - - "FE mesh refinement factor for trapezoidal quadrature" - + i%rhoinf = 0.0 ! - - - "Numerical damping parameter for generalized-alpha integrator" - + i%DTBeam = 2E-03 ! - - - "Time interval for BeamDyn calculations {or default} (s)" - + i%UsePitchAct = .false. ! - - - "Whether to use a pitch actuator inside BeamDyn" (flag) + i%pitchJ = 0.0 ! - - - "Pitch actuator inertia" (kg-m^2) + i%pitchK = 0.0 ! - - - "Pitch actuator stiffness" (kg-m^2/s^2) + i%pitchC = 0.0 ! - - - "Pitch actuator damping" - (kg-m^2/s) + i%Echo = .true. ! - - - "Echo" + i%NNodeOuts = 1 ! - - - "Number of node outputs [0 - 9]" - + i%OutNd = 1 ! {9} - - "Nodes whose values will be output" - + i%SumPrint = .true. ! - - - "Print summary data to file? (.sum)" - + i%OutFmt = "ES16.8E2" ! - - - "Format specifier" - + + ! fixed size arrays + i%kp_member = [3] !{:} - - "Number of key points in each member" - + i%OutList = ["TipTDxr, TipTDyr, TipTDzr", "TipRDxr, TipRDyr, TipRDzr"] ! {:} - - "List of user-requested output channels" - + + ! allocate arrays + call AllocAry(i%kp_coordinate, 3, 4, 'kp_coordinate', ErrStat, ErrMsg) + + ! construct arrays + i%kp_coordinate(1, :) = [0.000000, 0.000000, 0.0000, 0.00000] ! {:}{:} - - "Key point coordinates array" - + i%kp_coordinate(2, :) = [0.000000, 0.000000, 5.0000, 0.00000] + i%kp_coordinate(3, :) = [0.000000, 0.000000, 10.0000, 0.00000] + +end function + +type(BD_ContinuousStateType) function simpleContinuousStateType(node_total, nodes_per_elem, elem_total) result(x) + integer, intent(in) :: node_total, nodes_per_elem, elem_total + integer :: j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + + ! fixed size arrays + + ! allocate arrays + call AllocAry(x%q, 6, node_total, 'Displacement/Rotation Nodal DOF', ErrStat, ErrMsg) + call AllocAry(x%dqdt, 6, node_total, 'Velocity Nodal DOF', ErrStat, ErrMsg) + +end function + end module diff --git a/modules/inflowwind/tests/ifw_test_tools.F90 b/modules/inflowwind/tests/ifw_test_tools.F90 index 109fd36f77..62ede38903 100644 --- a/modules/inflowwind/tests/ifw_test_tools.F90 +++ b/modules/inflowwind/tests/ifw_test_tools.F90 @@ -40,9 +40,9 @@ function getInputFileData() '"unused" FilenameRoot - Rootname of the full-field wind file to use (.wnd, .sum) ', & 'False TowerFile - Have tower file (.twr) (flag) ', & '================== Parameters for HAWC-format binary files [Only used with WindType = 5] ===================== ', & - '"wasp\Output\basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & ' 64 nx - number of grids in the x direction (in the 3 files above) (-) ', & ' 32 ny - number of grids in the y direction (in the 3 files above) (-) ', & ' 32 nz - number of grids in the z direction (in the 3 files above) (-) ', & @@ -121,9 +121,9 @@ function getInputFileDataWindType2() '"unused" FilenameRoot - Rootname of the full-field wind file to use (.wnd, .sum) ', & 'False TowerFile - Have tower file (.twr) (flag) ', & '================== Parameters for HAWC-format binary files [Only used with WindType = 5] ===================== ', & - '"wasp\Output\basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & ' 64 nx - number of grids in the x direction (in the 3 files above) (-) ', & ' 32 ny - number of grids in the y direction (in the 3 files above) (-) ', & ' 32 nz - number of grids in the z direction (in the 3 files above) (-) ', & diff --git a/modules/inflowwind/tests/inflowwind_utest.F90 b/modules/inflowwind/tests/inflowwind_utest.F90 new file mode 100644 index 0000000000..83bf35405b --- /dev/null +++ b/modules/inflowwind/tests/inflowwind_utest.F90 @@ -0,0 +1,43 @@ +program inflowwind_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_bladed_wind, only: test_bladed_wind_suite +use test_hawc_wind, only: test_hawc_wind_suite +use test_outputs, only: test_outputs_suite +use test_steady_wind, only: test_steady_wind_suite +use test_turbsim_wind, only: test_turbsim_wind_suite +use test_uniform_wind, only: test_uniform_wind_suite +use NWTC_Num + +implicit none +integer :: stat, is +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("Bladed Wind", test_bladed_wind_suite), & + new_testsuite("HAWC Wind", test_hawc_wind_suite), & + new_testsuite("Outputs", test_outputs_suite), & + new_testsuite("Steady Wind", test_steady_wind_suite), & + new_testsuite("Turbsim Wind", test_turbsim_wind_suite), & + new_testsuite("Uniform Wind", test_uniform_wind_suite) & + ] + +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/inflowwind/tests/test_bladed_wind.F90 b/modules/inflowwind/tests/test_bladed_wind.F90 index 5dd860e139..3d3bd45134 100644 --- a/modules/inflowwind/tests/test_bladed_wind.F90 +++ b/modules/inflowwind/tests/test_bladed_wind.F90 @@ -1,35 +1,44 @@ module test_bladed_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none + +private +public :: test_bladed_wind_suite contains - @test - subroutine test_bladed_wind_input() +!> Collect all exported unit tests +subroutine test_bladed_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_bladed_wind_input", test_bladed_wind_input)] +end subroutine + +subroutine test_bladed_wind_input(error) + type(error_type), allocatable, intent(out) :: error - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg - CHARACTER(16) :: expected + character(16) :: expected - expected = "unused" - PriPath = "" + expected = "unused" + PriPath = "" - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(trim(expected), InputFileData%BladedFF_FileName) - @assertEqual(.FALSE., InputFileData%BladedFF_TowerFile) + call check(error, TmpErrStat, 0, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%BladedFF_FileName, trim(expected)); if (allocated(error)) return + call check(error, InputFileData%BladedFF_TowerFile, .false.); if (allocated(error)) return - end subroutine +end subroutine end module diff --git a/modules/inflowwind/tests/test_hawc_wind.F90 b/modules/inflowwind/tests/test_hawc_wind.F90 index 2e2e1a0b7c..e1b89efb95 100644 --- a/modules/inflowwind/tests/test_hawc_wind.F90 +++ b/modules/inflowwind/tests/test_hawc_wind.F90 @@ -1,62 +1,70 @@ module test_hawc_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_hawc_wind_suite contains - @test - subroutine test_hawc_wind_input() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - CHARACTER(32) :: expected_fnu - CHARACTER(32) :: expected_fnv - CHARACTER(32) :: expected_fnw - - PriPath = "" - expected_fnu = "wasp\Output\basic_5u.bin" - expected_fnv = "wasp\Output\basic_5v.bin" - expected_fnw = "wasp\Output\basic_5w.bin" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - - @assertEqual(trim(expected_fnu), InputFileData%HAWC_FileName_u) - @assertEqual(trim(expected_fnv), InputFileData%HAWC_FileName_v) - @assertEqual(trim(expected_fnw), InputFileData%HAWC_FileName_w) - @assertEqual(64, InputFileData%HAWC_nx) - @assertEqual(32, InputFileData%HAWC_ny) - @assertEqual(32, InputFileData%HAWC_nz) - @assertEqual(16, InputFileData%HAWC_dx) - @assertEqual(3, InputFileData%HAWC_dy) - @assertEqual(3, InputFileData%HAWC_dz) - @assertEqual(90, InputFileData%FF%RefHt) - - @assertEqual(1, InputFileData%FF%ScaleMethod) - @assertEqual(1, InputFileData%FF%SF(1)) - @assertEqual(1, InputFileData%FF%SF(2)) - @assertEqual(1, InputFileData%FF%SF(3)) - @assertEqual(12, InputFileData%FF%SigmaF(1)) - @assertEqual(8, InputFileData%FF%SigmaF(2)) - @assertEqual(2, InputFileData%FF%SigmaF(3)) - - @assertEqual(5, InputFileData%FF%URef) - @assertEqual(2, InputFileData%FF%WindProfileType) - @assertEqual(0, InputFileData%FF%PLExp) - @assertEqual(0.03, InputFileData%FF%Z0) - @assertEqual(0, InputFileData%FF%XOffset) - - end subroutine +!> Collect all exported unit tests +subroutine test_hawc_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_hawc_wind_input", test_hawc_wind_input)] +end subroutine + +subroutine test_hawc_wind_input(error) + type(error_type), allocatable, intent(out) :: error + + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + character(32) :: expected_fnu + character(32) :: expected_fnv + character(32) :: expected_fnw + + PriPath = "" + expected_fnu = "wasp/Output/basic_5u.bin" + expected_fnv = "wasp/Output/basic_5v.bin" + expected_fnw = "wasp/Output/basic_5w.bin" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + + call check(error, InputFileData%HAWC_FileName_u, trim(expected_fnu)); if (allocated(error)) return + call check(error, InputFileData%HAWC_FileName_v, trim(expected_fnv)); if (allocated(error)) return + call check(error, InputFileData%HAWC_FileName_w, trim(expected_fnw)); if (allocated(error)) return + call check(error, InputFileData%HAWC_nx, 64); if (allocated(error)) return + call check(error, InputFileData%HAWC_ny, 32); if (allocated(error)) return + call check(error, InputFileData%HAWC_nz, 32); if (allocated(error)) return + call check(error, InputFileData%HAWC_dx, 16.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%HAWC_dy, 3.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%HAWC_dz, 3.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%RefHt, 90.0_ReKi); if (allocated(error)) return + + call check(error, InputFileData%FF%ScaleMethod, 1); if (allocated(error)) return + call check(error, InputFileData%FF%SF(1), 1.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SF(2), 1.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SF(3), 1.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SigmaF(1), 12.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SigmaF(2), 8.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SigmaF(3), 2.0_ReKi); if (allocated(error)) return + + call check(error, InputFileData%FF%URef, 5.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%WindProfileType, 2); if (allocated(error)) return + call check(error, InputFileData%FF%PLExp, 0.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%Z0, 0.03_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%XOffset, 0.0_ReKi); if (allocated(error)) return + +end subroutine end module diff --git a/modules/inflowwind/tests/test_outputs.F90 b/modules/inflowwind/tests/test_outputs.F90 index a5acd741c5..9ecce090f0 100644 --- a/modules/inflowwind/tests/test_outputs.F90 +++ b/modules/inflowwind/tests/test_outputs.F90 @@ -1,62 +1,68 @@ module test_outputs - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_outputs_suite contains - @test - subroutine test_outputs_parsing() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(.FALSE., InputFileData%SumPrint) - @assertEqual("Wind1VelX", InputFileData%OutList(1)) - @assertEqual("Wind1VelY", InputFileData%OutList(2)) - @assertEqual("Wind1VelZ", InputFileData%OutList(3)) - - end subroutine - - - @test - subroutine test_outputs_parsing_alternate() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - InFileInfo%Lines(65:67) = (/ & - 'True SumPrint - Print summary data to .IfW.sum (flag) ', & - ' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)', & - '"Wind1VelX,Wind1VelY" - Wind velocity at point WindVxiList(1),WindVyiList(1),WindVziList(1). X, Y, and Z direction components. ' & - /) - - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(.TRUE., InputFileData%SumPrint) - @assertEqual("Wind1VelX", InputFileData%OutList(1)) - @assertEqual("Wind1VelY", InputFileData%OutList(2)) - - end subroutine +!> Collect all exported unit tests +subroutine test_outputs_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_outputs_parsing", test_outputs_parsing), & + new_unittest("test_outputs_parsing_alternate", test_outputs_parsing_alternate) & + ] +end subroutine + +subroutine test_outputs_parsing(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%SumPrint, .false.); if (allocated(error)) return + call check(error, InputFileData%OutList(1), "Wind1VelX"); if (allocated(error)) return + call check(error, InputFileData%OutList(2), "Wind1VelY"); if (allocated(error)) return + call check(error, InputFileData%OutList(3), "Wind1VelZ"); if (allocated(error)) return +end subroutine + +subroutine test_outputs_parsing_alternate(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + InFileInfo%Lines(65:67) = [ & + 'True SumPrint - Print summary data to .IfW.sum (flag) ', & + ' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)', & + '"Wind1VelX,Wind1VelY" - Wind velocity at point WindVxiList(1),WindVyiList(1),WindVziList(1). X, Y, and Z direction components. ' & + ] + + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%SumPrint, .true.); if (allocated(error)) return + call check(error, InputFileData%OutList(1), "Wind1VelX"); if (allocated(error)) return + call check(error, InputFileData%OutList(2), "Wind1VelY"); if (allocated(error)) return +end subroutine end module diff --git a/modules/inflowwind/tests/test_steady_wind.F90 b/modules/inflowwind/tests/test_steady_wind.F90 index 6b0578402e..ab611cfcc6 100644 --- a/modules/inflowwind/tests/test_steady_wind.F90 +++ b/modules/inflowwind/tests/test_steady_wind.F90 @@ -1,63 +1,71 @@ module test_steady_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_steady_wind_suite contains - @test - subroutine test_steady_wind_input_single_height() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(1, InputFileData%WindType) - @assertEqual(1, InputFileData%NWindVel) - @assertEqual(90, InputFileData%WindVziList(1)) - - end subroutine - - - @test - subroutine test_steady_wind_input_mult_heights() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - InFileInfo%Lines(9:12) = (/ & - ' 2 NWindVel - Number of points to output the wind velocity (0 to 9) ', & - ' 0,0 WindVxiList - List of coordinates in the inertial X direction (m) ', & - ' 0,0 WindVyiList - List of coordinates in the inertial Y direction (m) ', & - ' 80,100 WindVziList - List of coordinates in the inertial Z direction (m) ' & - /) - - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(1, InputFileData%WindType) - @assertEqual(2, InputFileData%NWindVel) - @assertEqual(80, InputFileData%WindVziList(1)) - @assertEqual(100, InputFileData%WindVziList(2)) - - end subroutine +!> Collect all exported unit tests +subroutine test_steady_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_steady_wind_input_single_height", test_steady_wind_input_single_height), & + new_unittest("test_steady_wind_input_mult_heights", test_steady_wind_input_mult_heights) & + ] +end subroutine + +subroutine test_steady_wind_input_single_height(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%WindType, 1); if (allocated(error)) return + call check(error, InputFileData%NWindVel, 1); if (allocated(error)) return + call check(error, InputFileData%WindVziList(1), 90.0_ReKi); if (allocated(error)) return + +end subroutine + +subroutine test_steady_wind_input_mult_heights(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + InFileInfo%Lines(9:12) = [ & + ' 2 NWindVel - Number of points to output the wind velocity (0 to 9) ', & + ' 0,0 WindVxiList - List of coordinates in the inertial X direction (m) ', & + ' 0,0 WindVyiList - List of coordinates in the inertial Y direction (m) ', & + ' 80,100 WindVziList - List of coordinates in the inertial Z direction (m) ' & + ] + + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%WindType, 1); if (allocated(error)) return + call check(error, InputFileData%NWindVel, 2); if (allocated(error)) return + call check(error, InputFileData%WindVziList(1), 80.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%WindVziList(2), 100.0_ReKi); if (allocated(error)) return + +end subroutine end module diff --git a/modules/inflowwind/tests/test_turbsim_wind.F90 b/modules/inflowwind/tests/test_turbsim_wind.F90 index 854b8497f4..58c4fcd910 100644 --- a/modules/inflowwind/tests/test_turbsim_wind.F90 +++ b/modules/inflowwind/tests/test_turbsim_wind.F90 @@ -1,34 +1,44 @@ module test_turbsim_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_turbsim_wind_suite contains - @test - subroutine test_steady_wind_input_single_height() +!> Collect all exported unit tests +subroutine test_turbsim_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_turbsim_wind_parse", test_turbsim_wind_parse) & + ] +end subroutine - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg +subroutine test_turbsim_wind_parse(error) + type(error_type), allocatable, intent(out) :: error - CHARACTER(16) :: expected + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg - expected = "Wind/08ms.wnd" - PriPath = "" + character(16) :: expected - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + expected = "Wind/08ms.wnd" + PriPath = "" - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(trim(expected), InputFileData%TSFF_FileName) + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - end subroutine + call check(error, 0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, trim(expected), InputFileData%TSFF_FileName); if (allocated(error)) return + +end subroutine end module diff --git a/modules/inflowwind/tests/test_uniform_wind.F90 b/modules/inflowwind/tests/test_uniform_wind.F90 index 39e2123948..914ea60b83 100644 --- a/modules/inflowwind/tests/test_uniform_wind.F90 +++ b/modules/inflowwind/tests/test_uniform_wind.F90 @@ -1,103 +1,113 @@ module test_uniform_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_uniform_wind_suite contains - @test - subroutine test_uniform_wind_input() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - CHARACTER(16) :: expected - - expected = "Wind/08ms.wnd" - PriPath = "" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(trim(expected), InputFileData%Uniform_FileName) - @assertEqual(90, InputFileData%Uniform_RefHt) - @assertEqual(125.88, InputFileData%Uniform_RefLength) - - end subroutine - - @test - subroutine test_uniform_wind_direct_data() - - ! Types for setting up module - TYPE(InflowWind_InitInputType) :: InitInp !< Input data for initialization - TYPE(InflowWind_InputType) :: InputGuess !< An initial guess for the input; the input mesh must be defined - TYPE(InflowWind_ParameterType) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType) :: ContStates !< Initial continuous states - TYPE(InflowWind_DiscreteStateType) :: DiscStates !< Initial discrete states - TYPE(InflowWind_ConstraintStateType) :: ConstrStateGuess !< Initial guess of the constraint states - TYPE(InflowWind_OtherStateType) :: OtherStates !< Initial other/optimization states - TYPE(InflowWind_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) - TYPE(InflowWind_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) - REAL(DbKi) :: TimeInterval !< Coupling time interval in seconds: InflowWind does not change this. - TYPE(InflowWind_InitOutputType) :: InitOutData - - ! Variables for testing - INTEGER :: ErrStat - CHARACTER(ErrMsgLen) :: ErrMsg - TYPE(FileInfoType) :: InFileInfo - TYPE(FileInfoType) :: WindType2Info - CHARACTER(1024), DIMENSION(6) :: data = (/ & - '! Wind file for sheared 18 m/s wind with 30 degree direction. ', & - '! Time Wind Wind Vert. Horiz. Vert. LinV Gust ', & - '! Speed Dir Speed Shear Shear Shear Speed ', & - ' 0.0 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ', & - ' 0.1 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ', & - ' 999.9 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ' & - /) - - ! Error handling - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg !< temporary error message - - InFileInfo = getInputFileDataWindType2() - CALL InitFileInfo(data, WindType2Info, ErrStat, ErrMsg) - - ! For diagnostic purposes, the following can be used to display the contents - ! of the InFileInfo data structure. - ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. - - ! Variable definitions - InitInp%InputFileName = "" - InitInp%NumWindPoints = 5 - InitInp%FilePassingMethod = 1_IntKi - InitInp%RootName = "" - InitInp%PassedFileInfo = InFileInfo - InitInp%WindType2UseInputFile = .FALSE. - InitInp%WindType2Info = WindType2Info - - CALL InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, & +!> Collect all exported unit tests +subroutine test_uniform_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_uniform_wind_input", test_uniform_wind_input), & + new_unittest("test_uniform_wind_direct_data", test_uniform_wind_direct_data) & + ] +end subroutine + +subroutine test_uniform_wind_input(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + character(16) :: expected + + expected = "Wind/08ms.wnd" + PriPath = "" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%Uniform_FileName, trim(expected)); if (allocated(error)) return + call check(error, InputFileData%Uniform_RefHt, 90.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%Uniform_RefLength, 125.88_ReKi); if (allocated(error)) return + +end subroutine + +subroutine test_uniform_wind_direct_data(error) + type(error_type), allocatable, intent(out) :: error + + ! Types for setting up module + type(InflowWind_InitInputType) :: InitInp !< Input data for initialization + type(InflowWind_InputType) :: InputGuess !< An initial guess for the input; the input mesh must be defined + type(InflowWind_ParameterType) :: p !< Parameters + type(InflowWind_ContinuousStateType) :: ContStates !< Initial continuous states + type(InflowWind_DiscreteStateType) :: DiscStates !< Initial discrete states + type(InflowWind_ConstraintStateType) :: ConstrStateGuess !< Initial guess of the constraint states + type(InflowWind_OtherStateType) :: OtherStates !< Initial other/optimization states + type(InflowWind_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) + type(InflowWind_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + real(DbKi) :: TimeInterval !< Coupling time interval in seconds: InflowWind does not change this. + type(InflowWind_InitOutputType) :: InitOutData + + ! Variables for testing + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + type(FileInfoType) :: InFileInfo + type(FileInfoType) :: WindType2Info + character(1024), dimension(6) :: data = [ & + '! Wind file for sheared 18 m/s wind with 30 degree direction. ', & + '! Time Wind Wind Vert. Horiz. Vert. LinV Gust ', & + '! Speed Dir Speed Shear Shear Shear Speed ', & + ' 0.0 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ', & + ' 0.1 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ', & + ' 999.9 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ' & + ] + + ! Error handling + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg !< temporary error message + + InFileInfo = getInputFileDataWindType2() + call InitFileInfo(data, WindType2Info, ErrStat, ErrMsg) + + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. + + ! Variable definitions + InitInp%InputFileName = "" + InitInp%NumWindPoints = 5 + InitInp%FilePassingMethod = 1_IntKi + InitInp%RootName = "" + InitInp%PassedFileInfo = InFileInfo + InitInp%WindType2UseInputFile = .false. + InitInp%WindType2Info = WindType2Info + + call InflowWind_Init(InitInp, InputGuess, p, ContStates, DiscStates, & ConstrStateGuess, OtherStates, y, m, TimeInterval, & InitOutData, TmpErrStat, TmpErrMsg) - ! Results - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(0.0, p%FlowField%Uniform%Time(1)) - @assertEqual(0.1, p%FlowField%Uniform%Time(2)) - @assertEqual(999.9, p%FlowField%Uniform%Time(3)) + ! Results + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, p%FlowField%Uniform%Time(1), 0.0_ReKi); if (allocated(error)) return + call check(error, p%FlowField%Uniform%Time(2), 0.1_ReKi); if (allocated(error)) return + call check(error, p%FlowField%Uniform%Time(3), 999.9_ReKi); if (allocated(error)) return - @assertEqual(12.0, p%FlowField%Uniform%VelH(1)) - @assertEqual(12.0, p%FlowField%Uniform%VelH(2)) - @assertEqual(12.0, p%FlowField%Uniform%VelH(3)) + call check(error, p%FlowField%Uniform%VelH(1), 12.0_ReKi); if (allocated(error)) return + call check(error, p%FlowField%Uniform%VelH(2), 12.0_ReKi); if (allocated(error)) return + call check(error, p%FlowField%Uniform%VelH(3), 12.0_ReKi); if (allocated(error)) return - end subroutine +end subroutine end module diff --git a/modules/nwtc-library/tests/nwtc_library_utest.F90 b/modules/nwtc-library/tests/nwtc_library_utest.F90 new file mode 100644 index 0000000000..33be4d3475 --- /dev/null +++ b/modules/nwtc-library/tests/nwtc_library_utest.F90 @@ -0,0 +1,35 @@ +program nwtc_library_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_NWTC_IO_FileInfo, only: test_NWTC_IO_FileInfo_suite +use test_NWTC_RandomNumber, only: test_NWTC_RandomNumber_suite +use NWTC_Num + +implicit none +integer :: stat, is +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("test_NWTC_IO_FileInfo", test_NWTC_IO_FileInfo_suite), & + new_testsuite("test_NWTC_RandomNumber_suite", test_NWTC_RandomNumber_suite) & + ] + +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 b/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 index 720ac96738..400885ece4 100644 --- a/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 +++ b/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 @@ -1,143 +1,153 @@ module test_NWTC_IO_FileInfo - use pFUnit_mod - use NWTC_IO - - implicit none +use iso_c_binding, only: c_char, c_null_char +use testdrive, only: new_unittest, unittest_type, error_type, check +use NWTC_IO + +implicit none +private +public :: test_NWTC_IO_FileInfo_suite contains -@test -subroutine test_initfileinfo() - - ! This case should result in error status 0. - ! It's a normal initialization of FileInfoType. - - integer, parameter :: num_lines = 5 - integer, parameter :: num_files = 1 - - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(MaxFileInfoLineLen) :: input_strings(num_lines) - type(FileInfoType) :: file_info_type - integer :: i - - input_strings = (/ & - "line 0", & - "line 1", & - "line 2", & - "line 3", & - "line 4" & - /) - call InitFileInfo( input_strings, file_info_type, error_status, error_message ) - - @assertEqual(num_lines, file_info_type%NumLines) - @assertEqual(num_files, file_info_type%NumFiles) - do i = 1, num_lines - @assertEqual(i, file_info_type%FileLine(i)) - end do - do i = 1, num_files - @assertEqual(i, file_info_type%FileIndx(i)) - end do - - ! TODO: test FileList when we actually use it - - do i = 1, num_lines - @assertEqual( trim(input_strings(i)), trim(file_info_type%Lines(i)) ) - end do - - @assertEqual( 0, error_status ) - @assertEqual( "", error_message ) +!> Collect all exported unit tests +subroutine test_NWTC_IO_FileInfo_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_initfileinfo", test_initfileinfo), & + new_unittest("test_initfileinfo2", test_initfileinfo2) & + ] end subroutine -@test -subroutine test_initfileinfo2() - - ! This case should result in a non-zero error status. - ! It attempts to initialize FileInfoType without having - ! properly initializing the input strings array. - - integer, parameter :: num_lines = 5 - integer, parameter :: num_files = 1 - - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(MaxFileInfoLineLen*2) :: input_strings(num_lines) - character(MaxFileInfoLineLen*2) :: tmpstring - type(FileInfoType) :: file_info_type - integer :: i - - input_strings = (/ & - "line 0", & - "line 1", & - "line 2", & - "line 3", & - "line 4" & - /) - ! make the last character a + so a trim does not reduce this string length - tmpstring=input_strings(5) - tmpstring(MaxFileInfoLineLen+1:MaxFileInfoLineLen+1) = 'a' - input_strings(5)=tmpstring - call InitFileInfo( input_strings, file_info_type, error_status, error_message ) - @assertEqual(num_lines, file_info_type%NumLines) - @assertEqual(num_files, file_info_type%NumFiles) - @assertEqual( 4, error_status ) - +subroutine test_initfileinfo(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in error status 0. + ! It's a normal initialization of FileInfoType. + + integer, parameter :: num_lines = 5 + integer, parameter :: num_files = 1 + + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + character(MaxFileInfoLineLen) :: input_strings(num_lines) + type(FileInfoType) :: file_info_type + integer :: i + + input_strings = (/ & + "line 0", & + "line 1", & + "line 2", & + "line 3", & + "line 4" & + /) + call InitFileInfo(input_strings, file_info_type, error_status, error_message) + + call check(error, num_lines, file_info_type%NumLines) + call check(error, num_files, file_info_type%NumFiles) + do i = 1, num_lines + call check(error, i, file_info_type%FileLine(i)) + end do + do i = 1, num_files + call check(error, i, file_info_type%FileIndx(i)) + end do + + ! TODO: test FileList when we actually use it + + do i = 1, num_lines + call check(error, trim(input_strings(i)), trim(file_info_type%Lines(i))) + end do + + call check(error, 0, error_status) + call check(error, "", error_message) end subroutine -@test -subroutine test_initfileinfo3() - USE ISO_C_BINDING, only: C_CHAR, C_NULL_CHAR - - ! This case should result in zero error status. - ! It attempts to initialize FileInfoType with a C_NULL_CHAR delimited string and compare with the equivalent array parsing - - integer, parameter :: num_lines = 7 - integer, parameter :: num_files = 1 - - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(kind=C_CHAR,len=MaxFileInfoLineLen*2) :: input_string - character(MaxFileInfoLineLen) :: input_string_array(num_lines) - type(FileInfoType) :: file_info_type - type(FileInfoType) :: file_info_type_array - integer :: i - - ! Fortron string array pass - input_string_array = (/ & - "line 0", & - "line 1", & - "line 2", & - "line 3", & - "line 4", & - "line 5", & - "line 6" & - /) - call InitFileInfo( input_string_array, file_info_type_array, error_status, error_message ) - @assertEqual(num_lines, file_info_type_array%NumLines) - @assertEqual(num_files, file_info_type_array%NumFiles) - @assertEqual( 0, error_status ) - - - ! Equivalent C_CHAR string to pass - ! Note: the rest of the input string is empty. This won't pose an issue since the remainder of the empty string is ignored. - input_string = "line 0"//C_NULL_CHAR// & - "line 1"//C_NULL_CHAR// & - "line 2"//C_NULL_CHAR// & - "line 3"//C_NULL_CHAR// & - "line 4"//C_NULL_CHAR// & - "line 5"//C_NULL_CHAR// & - "line 6"//C_NULL_CHAR - call InitFileInfo( input_string, file_info_type, error_status, error_message ) - @assertEqual(num_lines, file_info_type%NumLines) - @assertEqual(num_files, file_info_type%NumFiles) - @assertEqual( 0, error_status ) - - ! Now check that the entries are identical - do i = 1, num_lines - @assertEqual( trim(file_info_type_array%Lines(i)), trim(file_info_type%Lines(i)) ) - end do - +subroutine test_initfileinfo2(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in a non-zero error status. + ! It attempts to initialize FileInfoType without having + ! properly initializing the input strings array. + + integer, parameter :: num_lines = 5 + integer, parameter :: num_files = 1 + + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + character(MaxFileInfoLineLen*2) :: input_strings(num_lines) + character(MaxFileInfoLineLen*2) :: tmpstring + type(FileInfoType) :: file_info_type + integer :: i + + input_strings = (/ & + "line 0", & + "line 1", & + "line 2", & + "line 3", & + "line 4" & + /) + ! make the last character a + so a trim does not reduce this string length + tmpstring = input_strings(5) + tmpstring(MaxFileInfoLineLen + 1:MaxFileInfoLineLen + 1) = 'a' + input_strings(5) = tmpstring + call InitFileInfo(input_strings, file_info_type, error_status, error_message) + call check(error, num_lines, file_info_type%NumLines) + call check(error, num_files, file_info_type%NumFiles) + call check(error, 4, error_status) + +end subroutine + +subroutine test_initfileinfo3(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in zero error status. + ! It attempts to initialize FileInfoType with a C_NULL_CHAR delimited string and compare with the equivalent array parsing + + integer, parameter :: num_lines = 7 + integer, parameter :: num_files = 1 + + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + character(kind=C_CHAR, len=MaxFileInfoLineLen*2) :: input_string + character(MaxFileInfoLineLen) :: input_string_array(num_lines) + type(FileInfoType) :: file_info_type + type(FileInfoType) :: file_info_type_array + integer :: i + + ! Fortron string array pass + input_string_array = (/ & + "line 0", & + "line 1", & + "line 2", & + "line 3", & + "line 4", & + "line 5", & + "line 6" & + /) + call InitFileInfo(input_string_array, file_info_type_array, error_status, error_message) + call check(error, num_lines, file_info_type_array%NumLines) + call check(error, num_files, file_info_type_array%NumFiles) + call check(error, 0, error_status) + + ! Equivalent C_CHAR string to pass + ! Note: the rest of the input string is empty. This won't pose an issue since the remainder of the empty string is ignored. + input_string = "line 0"//C_NULL_CHAR// & + "line 1"//C_NULL_CHAR// & + "line 2"//C_NULL_CHAR// & + "line 3"//C_NULL_CHAR// & + "line 4"//C_NULL_CHAR// & + "line 5"//C_NULL_CHAR// & + "line 6"//C_NULL_CHAR + call InitFileInfo(input_string, file_info_type, error_status, error_message) + call check(error, num_lines, file_info_type%NumLines) + call check(error, num_files, file_info_type%NumFiles) + call check(error, 0, error_status) + + ! Now check that the entries are identical + do i = 1, num_lines + call check(error, trim(file_info_type_array%Lines(i)), trim(file_info_type%Lines(i))) + end do + end subroutine end module diff --git a/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 b/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 index 2821a521fe..9b080331e2 100644 --- a/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 +++ b/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 @@ -1,57 +1,70 @@ module test_NWTC_RandomNumber - use pFUnit_mod - use NWTC_RandomNumber - use nwtc_library_test_tools - - implicit none +use testdrive, only: new_unittest, unittest_type, error_type, check +use NWTC_RandomNumber +use nwtc_library_test_tools - character(1024), parameter :: dumpfile="randnumber.temp" +implicit none + +character(1024), parameter :: dumpfile = "randnumber.temp" + +private +public :: test_NWTC_RandomNumber_suite contains - -@test -subroutine test_RANLUX() - type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message +!> Collect all exported unit tests +subroutine test_NWTC_RandomNumber_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_RANLUX", test_RANLUX), & + new_unittest("test_INTRINSIC", test_INTRINSIC) & + ] +end subroutine + +subroutine test_RANLUX(error) + type(error_type), allocatable, intent(out) :: error + + type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message - real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers + real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers - p%pRNG = pRNG_RANLUX - p%RandSeed(1) = 1 + p%pRNG = pRNG_RANLUX + p%RandSeed(1) = 1 - call RandNum_Init(p, error_status, error_message) - @assertEqual( 0, error_status ) + call RandNum_Init(p, error_status, error_message) + call check(error, error_status, ErrID_None) - call UniformRandomNumbers(p%pRNG, random_numbers) - @assertEqual( (/ 0.94589489698410034, 0.47347849607467651 /), random_numbers ) + call UniformRandomNumbers(p%pRNG, random_numbers) + call check(error, 0.94589489698410034_ReKi, random_numbers(1)) + call check(error, 0.47347849607467651_ReKi, random_numbers(2)) end subroutine -@test -subroutine test_INTRINSIC() +subroutine test_INTRINSIC(error) + type(error_type), allocatable, intent(out) :: error - type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message + type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message - integer :: expected_seed_count - real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers + integer :: expected_seed_count + real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers - p%pRNG = pRNG_INTRINSIC - p%RandSeed(1) = 1 - p%RandSeed(2) = 2 + p%pRNG = pRNG_INTRINSIC + p%RandSeed(1) = 1 + p%RandSeed(2) = 2 - call hide_terminal_output() - call RandNum_Init(p, error_status, error_message) - call show_terminal_output() - @assertEqual( 0, error_status ) + call hide_terminal_output() + call RandNum_Init(p, error_status, error_message) + call show_terminal_output() + call check(error, error_status, ErrID_None) - ! We cant use this test since it will fail for various machine/compiler combinations - ! call UniformRandomNumbers(p%pRNG, random_numbers) - ! @assertEqual( (/ 0.80377975339288821, 0.47469797199574959 /), random_numbers ) + ! We cant use this test since it will fail for various machine/compiler combinations + ! call UniformRandomNumbers(p%pRNG, random_numbers) + ! call check(error, (/ 0.80377975339288821, 0.47469797199574959 /), random_numbers ) end subroutine end module diff --git a/modules/version/tests/test_VersionInfo_CheckArgs.F90 b/modules/version/tests/test_VersionInfo_CheckArgs.F90 index 78e0b7722b..6d709fcc5a 100644 --- a/modules/version/tests/test_VersionInfo_CheckArgs.F90 +++ b/modules/version/tests/test_VersionInfo_CheckArgs.F90 @@ -1,378 +1,368 @@ module test_VersionInfo_CheckArgs - use pFUnit_mod - use VersionInfo - use versioninfo_test_tools - - implicit none - - contains - - ! PASSING CASES - - ! ************************************************************************ - ! To read the input file, a default may be provided and a user-specified - ! input file may be used instead. - - @test - subroutine test_input_file_user_specified() - - ! executable.exe FileName - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(1)) - argument_array = (/ & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_input_file_default() - - ! executable.exe - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "default.txt" - allocate(argument_array(0)) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "default.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_input_file_default_user_specified() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "default.txt" - allocate(argument_array(1)) - argument_array = (/ & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! Given a restart flag, the flag should be parsed along with the input - ! file and second argument regardless of the position of the flag. - ! The first argument is optional in this case. - - @test - subroutine test_restart_flag1() - - ! executable.exe -Flag FileName Arg2 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(3)) - argument_array = (/ & - "-restart ", & - "first_arg.txt ", & - "second_arg " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "second_arg", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_restart_flag2() - - ! executable.exe FileName -Flag Arg2 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(3)) - argument_array = (/ & - "first_arg.txt ", & - "-restart ", & - "second_arg " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "second_arg", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_restart_flag3() - - ! executable.exe -restart Arg1 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "-restart ", & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "first_arg.txt", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The second argument should be returned when provided even outside - ! of the restart functionality. - - @test - subroutine test_second_argument() - - ! executable.exe FileName Arg2 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "second_arg " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "second_arg", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The help flag in any position should show the help prompt and exit - ! normally. - - @test - subroutine test_help1() - - ! executable.exe -Flag FileName - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "-h ", & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "H", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_help2() - - ! executable.exe FileName -Flag - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "-h " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "H", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The version flag in any position should show the version info and exit - ! normally. - - @test - subroutine test_version1() - - ! executable.exe -v FileName - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "-v ", & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "V", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_version2() - - ! executable.exe FileName -VERSION - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "-VERSION " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "VERSION", flag ) - deallocate(argument_array) - end subroutine - - ! FAILING CASES - - ! ************************************************************************ - ! No arguments and no default input file should exit with an error - - @test - subroutine test_no_args_no_default() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(0)) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "", filename ) - @assertEqual( 4, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! An unsupported flag should exit with an error - - @test - subroutine test_unsupported_flag() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "-flag " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 4, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "FLAG", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The restart flag requires at least one additional argument - - @test - subroutine test_restart_bad_syntax() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(1)) - argument_array = (/ & - "-restart " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "", filename ) - @assertEqual( 4, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine +use testdrive, only: new_unittest, unittest_type, error_type, check +use VersionInfo +use versioninfo_test_tools + +implicit none + +private +public :: test_VersionInfo_CheckArgs_suite + +contains + +!> Collect all exported unit tests +subroutine test_VersionInfo_CheckArgs_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_input_file_user_specified", test_input_file_user_specified), & + new_unittest("test_input_file_default", test_input_file_default), & + new_unittest("test_input_file_default_user_specified", test_input_file_default_user_specified), & + new_unittest("test_restart_flag1", test_restart_flag1), & + new_unittest("test_restart_flag2", test_restart_flag2), & + new_unittest("test_restart_flag3", test_restart_flag3), & + new_unittest("test_second_argument", test_second_argument), & + new_unittest("test_help1", test_help1), & + new_unittest("test_help2", test_help2), & + new_unittest("test_version1", test_version1), & + new_unittest("test_version2", test_version2), & + new_unittest("test_no_args_no_default", test_no_args_no_default), & + new_unittest("test_unsupported_flag", test_unsupported_flag), & + new_unittest("test_restart_bad_syntax", test_restart_bad_syntax) & + ] +end subroutine + +! PASSING CASES + +! ************************************************************************ +! To read the input file, a default may be provided and a user-specified +! input file may be used instead. + +subroutine test_input_file_user_specified(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(1)) + argument_array = ["first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_input_file_default(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "default.txt" + allocate (argument_array(0)) + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "default.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_input_file_default_user_specified(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "default.txt" + allocate (argument_array(1)) + argument_array = ["first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! Given a restart flag, the flag should be parsed along with the input +! file and second argument regardless of the position of the flag. +! The first argument is optional in this case. + +subroutine test_restart_flag1(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -Flag FileName Arg2 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(3)) + argument_array = ["-restart ", & + "first_arg.txt ", & + "second_arg "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "second_arg", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_restart_flag2(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName -Flag Arg2 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(3)) + argument_array = ["first_arg.txt ", "-restart ", "second_arg "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "second_arg", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_restart_flag3(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -restart Arg1 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["-restart ", "first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "first_arg.txt", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The second argument should be returned when provided even outside +! of the restart functionality. + +subroutine test_second_argument(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName Arg2 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "second_arg "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "second_arg", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The help flag in any position should show the help prompt and exit +! normally. + +subroutine test_help1(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -Flag FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["-h ", "first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "H", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_help2(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName -Flag + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "-h "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "H", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The version flag in any position should show the version info and exit +! normally. + +subroutine test_version1(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -v FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["-v ", "first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "V", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_version2(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName -VERSION + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "-VERSION "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "VERSION", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! FAILING CASES + +! ************************************************************************ +! No arguments and no default input file should exit with an error + +subroutine test_no_args_no_default(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(0)) + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "", filename); if (allocated(error)) return + call check(error, 4, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! An unsupported flag should exit with an error + +subroutine test_unsupported_flag(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "-flag "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 4, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "FLAG", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The restart flag requires at least one additional argument + +subroutine test_restart_bad_syntax(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(1)) + argument_array = ["-restart "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "", filename); if (allocated(error)) return + call check(error, 4, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine end module diff --git a/modules/version/tests/versioninfo_utest.F90 b/modules/version/tests/versioninfo_utest.F90 new file mode 100644 index 0000000000..c58ba55614 --- /dev/null +++ b/modules/version/tests/versioninfo_utest.F90 @@ -0,0 +1,33 @@ +program versioninfo_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_VersionInfo_CheckArgs, only: test_VersionInfo_CheckArgs_suite +use NWTC_Num + +implicit none +integer :: stat, is +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("test_VersionInfo_CheckArgs", test_VersionInfo_CheckArgs_suite) & + ] + +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/unit_tests/CMakeLists.txt b/unit_tests/CMakeLists.txt index 4a3b7e4d08..11d3114f9e 100644 --- a/unit_tests/CMakeLists.txt +++ b/unit_tests/CMakeLists.txt @@ -18,62 +18,65 @@ # -- OpenFAST Unit Testing # ----------------------------------------------------------- -cmake_minimum_required(VERSION 3.12) -project(OpenFAST_UnitTest Fortran) - include(CTest) -if(NOT ${Python_Interpreter_FOUND}) - message(FATAL_ERROR "CMake did not find a Python interpreter. Python is required for unit tests." ) -endif() -if (${Python_VERSION} VERSION_GREATER_EQUAL "3.12.0") - message(FATAL_ERROR "Unit testing with pfunit not currently possible with Python 3.12 or greater." ) -endif() - - +# Test-Drive library +add_library(testdrivelib test-drive/testdrive.F90 test-drive/testdrive_version.f90) -### pfunit -include(ExternalProject) +# AeroDyn Unit Tests +add_executable(aerodyn_utest + ${PROJECT_SOURCE_DIR}/modules/aerodyn/tests/aerodyn_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/aerodyn/tests/test_AD_FVW.F90 +) +target_link_libraries(aerodyn_utest aerodynlib versioninfolib testdrivelib) +add_test(NAME aerodyn_utest COMMAND aerodyn_utest) -set(PFUNIT_INSTALL ${PROJECT_BINARY_DIR}/pfunit) -set(PFUNIT_LIB_PATH ${PROJECT_BINARY_DIR}/pfunit/lib/${CMAKE_STATIC_LIBRARY_PREFIX}pfunit${CMAKE_STATIC_LIBRARY_SUFFIX}) -set(build_testdirectory ${PROJECT_BINARY_DIR}/tests) -set(source_modulesdirectory ${PROJECT_SOURCE_DIR}/../modules) -set(pfunit_directory ${PFUNIT_INSTALL}) +# BeamDyn Unit Tests +add_executable(beamdyn_utest + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/beamdyn_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_Crv.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_Misc.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_diffmtc.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_MemberEta.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_tools.F90 +) +target_link_libraries(beamdyn_utest beamdynlib versioninfolib testdrivelib) +add_test(NAME beamdyn_utest COMMAND beamdyn_utest) -ExternalProject_Add(pfunit - SOURCE_DIR ${PROJECT_SOURCE_DIR}/pfunit - BINARY_DIR ${PROJECT_BINARY_DIR}/pfunit-build - STAMP_DIR ${PROJECT_BINARY_DIR}/pfunit-stamp - TMP_DIR ${PROJECT_BINARY_DIR}/pfunit-tmp - INSTALL_DIR ${PFUNIT_INSTALL} - CMAKE_ARGS - -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/pfunit - -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} - -DPYTHON_EXECUTABLE=${Python_EXECUTABLE} - -DROBUST=OFF - BUILD_BYPRODUCTS - ${PFUNIT_LIB_PATH} - ${PFUNIT_INSTALL}/include/driver.F90 +# InflowWind Unit Tests +add_executable(inflowwind_utest + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/inflowwind_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_bladed_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_hawc_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_outputs.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_steady_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_turbsim_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_uniform_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/ifw_test_tools.F90 ) -add_library(pfunit_lib STATIC IMPORTED) -set_target_properties(pfunit_lib PROPERTIES IMPORTED_LOCATION ${PFUNIT_LIB_PATH}) +target_link_libraries(inflowwind_utest ifwlib versioninfolib testdrivelib) +add_test(NAME inflowwind_utest COMMAND inflowwind_utest) -include_directories( - ${PROJECT_SOURCE_DIR} - ${PROJECT_BINARY_DIR}/pfunit/mod - ${PROJECT_BINARY_DIR}/tests - ${PFUNIT_INSTALL}/mod +# NWTC Library Unit Tests +add_executable(nwtc_library_utest + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/nwtc_library_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/NWTC_Library_test_tools.F90 + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 ) +target_link_libraries(nwtc_library_utest nwtclibs testdrivelib) -### Add the unit tests here -add_subdirectory("beamdyn") -add_subdirectory("nwtc-library") -add_subdirectory("aerodyn") -add_subdirectory("inflowwind") -add_subdirectory("version") +add_test(NAME nwtc_library_utest COMMAND nwtc_library_utest) -add_custom_target( - unit_tests - DEPENDS beamdyn_utest nwtc_library_utest fvw_utest inflowwind_utest versioninfo_utest +# Version Info Unit Tests +add_executable(versioninfo_utest + ${PROJECT_SOURCE_DIR}/modules/version/tests/versioninfo_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/version/tests/VersionInfo_test_tools.F90 + ${PROJECT_SOURCE_DIR}/modules/version/tests/test_VersionInfo_CheckArgs.F90 ) +target_link_libraries(versioninfo_utest versioninfolib testdrivelib) +add_test(NAME versioninfo_utest COMMAND versioninfo_utest) diff --git a/unit_tests/README.md b/unit_tests/README.md index 48cc589484..511b8a53bd 100644 --- a/unit_tests/README.md +++ b/unit_tests/README.md @@ -1,14 +1,12 @@ # openfast/unit_tests This directory contains the unit test suite for the OpenFAST framework. Contained in this directory are -- [pFUnit](http://pfunit.sourceforge.net), an external framework for Fortran unit testing +- [test-drive](https://github.com/fortran-lang/test-drive), an external framework for Fortran unit testing (commit a78870c, November 24, 2023) - CMake configuration file -- A unit test template file The dependencies for unit testing are: -- Python 3.7+ -- pFUnit +- test-drive - CMake ### Usage -See [readthedocs](http://openfast.readthedocs.io/en/latest/source/user/testing/unit_test.html) for complete documentation on OpenFAST unit test usage and expansion. \ No newline at end of file +See [readthedocs](http://openfast.readthedocs.io/en/latest/source/user/testing/unit_test.html) for complete documentation on OpenFAST unit test usage. \ No newline at end of file diff --git a/unit_tests/aerodyn/CMakeLists.txt b/unit_tests/aerodyn/CMakeLists.txt deleted file mode 100644 index 3704d84d3f..0000000000 --- a/unit_tests/aerodyn/CMakeLists.txt +++ /dev/null @@ -1,57 +0,0 @@ -# -# Copyright 2017 National Renewable Energy Laboratory -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "fvw") -set(module_directory "aerodyn") -set(module_library "aerodynlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${build_testdirectory}/${module_directory}) - -set(testlist - test_FVW_testsuite -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${Python_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - pfunit_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/unit_tests/beamdyn/CMakeLists.txt b/unit_tests/beamdyn/CMakeLists.txt deleted file mode 100644 index 2d35a3d16d..0000000000 --- a/unit_tests/beamdyn/CMakeLists.txt +++ /dev/null @@ -1,76 +0,0 @@ -# -# Copyright 2017 National Renewable Energy Laboratory -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "beamdyn") -set(module_directory "beamdyn") -set(module_library "beamdynlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${build_testdirectory}/${module_directory}) - -set(testlist - test_tools - test_BD_ComputeIniNodalCrv - test_BD_CrvCompose - test_BD_CheckRotMat - test_BD_CrvExtractCrv - test_BD_CrvMatrixR - test_BD_CrvMatrixH - test_ExtractRelativeRotation - test_BD_InputGlobalLocal - test_BD_DistrLoadCopy - test_BD_GravityForce - test_BD_QPData_mEta_rho - test_BD_GenerateGLL - test_BD_GaussPointWeight - test_BD_diffmtc - test_BD_InitShpDerJaco - test_BD_MemberEta - test_BD_QuadraturePointData - test_BD_TrapezoidalPointWeight - test_InitializeNodalLocations -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${Python_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - pfunit_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/unit_tests/inflowwind/CMakeLists.txt b/unit_tests/inflowwind/CMakeLists.txt deleted file mode 100644 index 2797e1addc..0000000000 --- a/unit_tests/inflowwind/CMakeLists.txt +++ /dev/null @@ -1,63 +0,0 @@ -# -# Copyright 2017 National Renewable Energy Laboratory -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "inflowwind") -set(module_directory "inflowwind") -set(module_library "ifwlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${build_testdirectory}/${module_directory}) - -set(testlist - ifw_test_tools - test_steady_wind - test_turbsim_wind - test_bladed_wind - test_hawc_wind - test_outputs - test_uniform_wind -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${Python_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - pfunit_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/unit_tests/nwtc-library/CMakeLists.txt b/unit_tests/nwtc-library/CMakeLists.txt deleted file mode 100644 index 9f59837155..0000000000 --- a/unit_tests/nwtc-library/CMakeLists.txt +++ /dev/null @@ -1,61 +0,0 @@ -# -# Copyright 2017 National Renewable Energy Laboratory -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# - -# Tell CMake not to look for this file to exist since its generated by pFUnit during compile -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "nwtc_library") -set(module_directory "nwtc-library") -set(module_library "nwtclibs") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${build_testdirectory}/${module_directory}) - -set(testlist - NWTC_Library_test_tools - test_NWTC_IO_FileInfo - test_NWTC_RandomNumber -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${Python_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - pfunit_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) - diff --git a/unit_tests/pfunit b/unit_tests/pfunit deleted file mode 160000 index a192e82246..0000000000 --- a/unit_tests/pfunit +++ /dev/null @@ -1 +0,0 @@ -Subproject commit a192e82246b44e701446811a9792a530e4f250c7 diff --git a/unit_tests/test-drive/LICENSE-Apache b/unit_tests/test-drive/LICENSE-Apache new file mode 100644 index 0000000000..d645695673 --- /dev/null +++ b/unit_tests/test-drive/LICENSE-Apache @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/unit_tests/test-drive/LICENSE-MIT b/unit_tests/test-drive/LICENSE-MIT new file mode 100644 index 0000000000..058480f520 --- /dev/null +++ b/unit_tests/test-drive/LICENSE-MIT @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2020-2021 Sebastian Ehlert + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/unit_tests/test-drive/README.md b/unit_tests/test-drive/README.md new file mode 100644 index 0000000000..dfe0f7e227 --- /dev/null +++ b/unit_tests/test-drive/README.md @@ -0,0 +1,511 @@ +# The simple testing framework + +[![License](https://img.shields.io/badge/license-MIT%7CApache%202.0-blue)](LICENSE-Apache) +[![Latest Version](https://img.shields.io/github/v/release/fortran-lang/test-drive)](https://github.com/fortran-lang/test-drive/releases/latest) +[![CI](https://github.com/fortran-lang/test-drive/workflows/CI/badge.svg)](https://github.com/fortran-lang/test-drive/actions) +[![codecov](https://codecov.io/gh/fortran-lang/test-drive/branch/main/graph/badge.svg)](https://codecov.io/gh/fortran-lang/test-drive) + +This project offers a lightweight, procedural unit testing framework based on nothing but standard Fortran. +Integration with [meson](https://mesonbuild.com), [cmake](https://cmake.org) and [Fortran package manager (fpm)](https://github.com/fortran-lang/fpm) is available. +Alternatively, the [``testdrive.F90``](src/testdrive.F90) source file can be redistributed in the project's testsuite as well. + + +## Usage + +Testsuites are defined by a ``collect_interface`` returning a set of ``unittest_type`` objects. +To create a new test use the ``new_unittest`` constructor, which requires a test identifier and a procedure with a ``test_interface`` compatible signature. +The error status is communicated by the allocation status of an ``error_type``. + +The necessary boilerplate code to setup the test entry point is just + +```fortran +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_suite1, only : collect_suite1 + use test_suite2, only : collect_suite2 + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("suite1", collect_suite1), & + new_testsuite("suite2", collect_suite2) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if + +end program tester +``` + +Every test is defined in a separate module using a ``collect`` function, which is exported and added to the ``testsuites`` array in the test runner. +All tests have a simple interface with just an allocatable ``error_type`` as output to provide the test results. + +```fortran +module test_suite1 + use testdrive, only : new_unittest, unittest_type, error_type, check + implicit none + private + + public :: collect_suite1 + +contains + +!> Collect all exported unit tests +subroutine collect_suite1(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("valid", test_valid), & + new_unittest("invalid", test_invalid, should_fail=.true.) & + ] + +end subroutine collect_suite1 + +subroutine test_valid(error) + type(error_type), allocatable, intent(out) :: error + ! ... +end subroutine test_valid + +subroutine test_invalid(error) + type(error_type), allocatable, intent(out) :: error + ! ... +end subroutine test_invalid + +end module test_suite1 +``` + + +### Checking test conditions + +The procedures defining the tests can contain any Fortran code required for checking the correctness of the project. +An easy way to do so is provided by the generic ``check`` function. + +```f90 +subroutine test_valid(error) + type(error_type), allocatable, intent(out) :: error + + call check(error, 1 + 2 == 3) + if (allocated(error)) return + + ! equivalent to the above + call check(error, 1 + 2, 3) + if (allocated(error)) return +end subroutine test_valid +``` + +After each check, the status of the error should be checked. +Uncaught errors will not be silently dropped, instead the error will be caught, its message displayed and the run aborted. +Possible ways to use check are listed below + +| available checks | arguments | +| -------------------- | -------------------------------------------------------------- | +| logical check | *error*, *logical*, ... | +| status check | *error*, *integer*, ... | +| logical comparison | *error*, *logical*, *logical*, ... | +| integer comparison | *error*, *integer*, ... | +| character comparison | *error*, *character*, *character*, ... | +| real comparison | *error*, *real*, *real*, ..., thr=*real*, rel=*logical* | +| real NaN check | *error*, *real*, ... | +| complex comparison | *error*, *complex*, *complex*, ..., thr=*real*, rel=*logical* | +| complex NaN check | *error*, *complex*, ... | + +Each check will generate a meaningful error message based on the available arguments, but can also be provided with a custom error message instead. + +To generate custom checks the ``test_failed`` procedure is available to generate error messages + +```f90 +subroutine test_custom(error) + type(error_type), allocatable, intent(out) :: error + + ! ... + + if (.not.cond) then + call test_failed(error, "Custom check failed") + return + end if + + ! ... + + if (.not.cond) then + call test_failed(error, "Custom check failed", "Additional context") + return + end if + +end subroutine test_custom +``` + +To conditionally skip a test use the ``skip_test`` procedure. +It uses the same signature as ``test_failed``, but will mark the respective test as skipped, this is useful to disable tests based on conditional compilation, *e.g.* by using a preprocessor or a different submodule. +An uncaught skipped test will fail regardless, therefore make sure to not run any other checks afterwards. + + +### Integration in build systems + +Finally, for usage with *fpm* it is beneficial to have a single test driver which can run all tests. +While this brings the disadvantage of always having to run the complete testsuite, the main driver can provide the flexibility to select the suite and also the unit test using the boilerplate code shown here: + +```f90 +!> Driver for unit testing +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type, & + & select_suite, run_selected, get_argument + use test_suite1, only : collect_suite1 + use test_suite2, only : collect_suite2 + implicit none + integer :: stat, is + character(len=:), allocatable :: suite_name, test_name + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("suite1", collect_suite1), & + new_testsuite("suite2", collect_suite2) & + ] + + call get_argument(1, suite_name) + call get_argument(2, test_name) + + if (allocated(suite_name)) then + is = select_suite(testsuites, suite_name) + if (is > 0 .and. is <= size(testsuites)) then + if (allocated(test_name)) then + write(error_unit, fmt) "Suite:", testsuites(is)%name + call run_selected(testsuites(is)%collect, test_name, error_unit, stat) + if (stat < 0) then + error stop 1 + end if + else + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end if + else + write(error_unit, fmt) "Available testsuites" + do is = 1, size(testsuites) + write(error_unit, fmt) "-", testsuites(is)%name + end do + error stop 1 + end if + else + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + end if + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop 1 + end if + +end program tester +``` + +From *fpm* this allows to run all tests using just the *fpm test* command, but also to debug an individual test in a debugger. +For example to run *broken-test* in *large-suite* with ``gdb`` use + +``` +fpm test --runner gdb -- large-suite broken-test +``` + +To make this approach feasible for meson the tests can be created as individual suites. +A usual layout of the test directory like + +``` +test +├── main.f90 +├── meson.build +├── test_suite1.f90 +├── test_suite2.f90 +└── ... +``` + +Can use the following snippet to automatically create individual tests running complete suites inside the driver. +Resolution to the unit tests is possible but usually not desired, because the individual runtime of the tests will be short compared to the overhead to start the actual test. + +```meson +testdrive_dep = dependency('test-drive', fallback: ['test-drive', 'testdrive_dep']) + +tests = [ + 'suite1', + 'suite2', + # ... +] + +test_srcs = files( + 'main.f90', +) +foreach t : tests + test_srcs += files('test_@0@.f90'.format(t.underscorify())) +endforeach + +tester = executable( + 'tester', + sources: test_srcs, + dependencies: [proj_dep, testdrive_dep], +) + +test('all tests', tester) + +foreach t : tests + test(t, tester, args: t) +endforeach +``` + +Similar for a CMake based build the tests can be generated automatically for the layout shown below. + +``` +test +├── CMakeLists.txt +├── main.f90 +├── test_suite1.f90 +├── test_suite2.f90 +└── ... +``` + +The CMake file in the test directory should look similar to the one shown here + +```cmake +if(NOT TARGET "test-drive::test-drive") + find_package("test-drive" REQUIRED) +endif() + +# Unit testing +set( + tests + "suite1" + "suite2" +) +set( + test-srcs + "main.f90" +) +foreach(t IN LISTS tests) + string(MAKE_C_IDENTIFIER ${t} t) + list(APPEND test-srcs "test_${t}.f90") +endforeach() + +add_executable( + "${PROJECT_NAME}-tester" + "${test-srcs}" +) +target_link_libraries( + "${PROJECT_NAME}-tester" + PRIVATE + "${PROJECT_NAME}-lib" + "test-drive::test-drive" +) + +foreach(t IN LISTS tests) + add_test("${PROJECT_NAME}/${t}" "${PROJECT_NAME}-tester" "${t}") +endforeach() +``` + +
+CMake module to find testing framework + +The following module allows to find or fetch an installation of this project in CMake + +```cmake +#[[.rst: +Find test-drive +--------------- + +Makes the test-drive project available. + +Imported Targets +^^^^^^^^^^^^^^^^ + +This module provides the following imported target, if found: + +``test-drive::test-drive`` + The test-drive library + + +Result Variables +^^^^^^^^^^^^^^^^ + +This module will define the following variables: + +``TEST_DRIVE_FOUND`` + True if the test-drive library is available + +``TEST_DRIVE_SOURCE_DIR`` + Path to the source directory of the test-drive project, + only set if the project is included as source. + +``TEST_DRIVE_BINARY_DIR`` + Path to the binary directory of the test-drive project, + only set if the project is included as source. + +Cache variables +^^^^^^^^^^^^^^^ + +The following cache variables may be set to influence the library detection: + +``TEST_DRIVE_FIND_METHOD`` + Methods to find or make the project available. Available methods are + - ``cmake``: Try to find via CMake config file + - ``pkgconf``: Try to find via pkg-config file + - ``subproject``: Use source in subprojects directory + - ``fetch``: Fetch the source from upstream + +``TEST_DRIVE_DIR`` + Used for searching the CMake config file + +``TEST_DRIVE_SUBPROJECT`` + Directory to find the test-drive subproject, relative to the project root + +#]] + +set(_lib "test-drive") +set(_pkg "TEST_DRIVE") +set(_url "https://github.com/fortran-lang/test-drive") + +if(NOT DEFINED "${_pkg}_FIND_METHOD") + if(DEFINED "${PROJECT_NAME}-dependency-method") + set("${_pkg}_FIND_METHOD" "${${PROJECT_NAME}-dependency-method}") + else() + set("${_pkg}_FIND_METHOD" "cmake" "pkgconf" "subproject" "fetch") + endif() + set("_${_pkg}_FIND_METHOD") +endif() + +foreach(method ${${_pkg}_FIND_METHOD}) + if(TARGET "${_lib}::${_lib}") + break() + endif() + + if("${method}" STREQUAL "cmake") + message(STATUS "${_lib}: Find installed package") + if(DEFINED "${_pkg}_DIR") + set("_${_pkg}_DIR") + set("${_lib}_DIR" "${_pkg}_DIR") + endif() + find_package("${_lib}" CONFIG) + if("${_lib}_FOUND") + message(STATUS "${_lib}: Found installed package") + break() + endif() + endif() + + if("${method}" STREQUAL "pkgconf") + find_package(PkgConfig QUIET) + pkg_check_modules("${_pkg}" QUIET "${_lib}") + if("${_pkg}_FOUND") + message(STATUS "Found ${_lib} via pkg-config") + + add_library("${_lib}::${_lib}" INTERFACE IMPORTED) + target_link_libraries( + "${_lib}::${_lib}" + INTERFACE + "${${_pkg}_LINK_LIBRARIES}" + ) + target_include_directories( + "${_lib}::${_lib}" + INTERFACE + "${${_pkg}_INCLUDE_DIRS}" + ) + + break() + endif() + endif() + + if("${method}" STREQUAL "subproject") + if(NOT DEFINED "${_pkg}_SUBPROJECT") + set("_${_pkg}_SUBPROJECT") + set("${_pkg}_SUBPROJECT" "subprojects/${_lib}") + endif() + set("${_pkg}_SOURCE_DIR" "${PROJECT_SOURCE_DIR}/${${_pkg}_SUBPROJECT}") + set("${_pkg}_BINARY_DIR" "${PROJECT_BINARY_DIR}/${${_pkg}_SUBPROJECT}") + if(EXISTS "${${_pkg}_SOURCE_DIR}/CMakeLists.txt") + message(STATUS "Include ${_lib} from ${${_pkg}_SUBPROJECT}") + add_subdirectory( + "${${_pkg}_SOURCE_DIR}" + "${${_pkg}_BINARY_DIR}" + ) + + add_library("${_lib}::${_lib}" INTERFACE IMPORTED) + target_link_libraries("${_lib}::${_lib}" INTERFACE "${_lib}") + + # We need the module directory in the subproject before we finish the configure stage + if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include") + make_directory("${${_pkg}_BINARY_DIR}/include") + endif() + + break() + endif() + endif() + + if("${method}" STREQUAL "fetch") + message(STATUS "Retrieving ${_lib} from ${_url}") + include(FetchContent) + FetchContent_Declare( + "${_lib}" + GIT_REPOSITORY "${_url}" + GIT_TAG "HEAD" + ) + FetchContent_MakeAvailable("${_lib}") + + add_library("${_lib}::${_lib}" INTERFACE IMPORTED) + target_link_libraries("${_lib}::${_lib}" INTERFACE "${_lib}") + + # We need the module directory in the subproject before we finish the configure stage + FetchContent_GetProperties("${_lib}" SOURCE_DIR "${_pkg}_SOURCE_DIR") + FetchContent_GetProperties("${_lib}" BINARY_DIR "${_pkg}_BINARY_DIR") + if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include") + make_directory("${${_pkg}_BINARY_DIR}/include") + endif() + + break() + endif() + +endforeach() + +if(TARGET "${_lib}::${_lib}") + set("${_pkg}_FOUND" TRUE) +else() + set("${_pkg}_FOUND" FALSE) +endif() + +if(DEFINED "_${_pkg}_SUBPROJECT") + unset("${_pkg}_SUBPROJECT") + unset("_${_pkg}_SUBPROJECT") +endif() +if(DEFINED "_${_pkg}_DIR") + unset("${_lib}_DIR") + unset("_${_pkg}_DIR") +endif() +if(DEFINED "_${_pkg}_FIND_METHOD") + unset("${_pkg}_FIND_METHOD") + unset("_${_pkg}_FIND_METHOD") +endif() +unset(_lib) +unset(_pkg) +unset(_url) +``` +
+ + +## License + +This project is free software: you can redistribute it and/or modify it under the terms of the [Apache License, Version 2.0](LICENSE-Apache) or [MIT license](LICENSE-MIT) at your opinion. + +Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an _as is_ basis, without warranties or conditions of any kind, either express or implied. See the License for the specific language governing permissions and limitations under the License. + +Unless you explicitly state otherwise, any contribution intentionally submitted for inclusion in this project by you, as defined in the Apache-2.0 license, shall be dual licensed as above, without any additional terms or conditions. diff --git a/unit_tests/test-drive/testdrive.F90 b/unit_tests/test-drive/testdrive.F90 new file mode 100644 index 0000000000..0cd6b83dfb --- /dev/null +++ b/unit_tests/test-drive/testdrive.F90 @@ -0,0 +1,1988 @@ +! This file is part of test-drive. +! SPDX-Identifier: Apache-2.0 OR MIT +! +! Licensed under either of Apache License, Version 2.0 or MIT license +! at your option; you may not use this file except in compliance with +! the License. +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +!# Enable support for quadruple precision +#ifndef WITH_QP +#define WITH_QP 0 +#endif + +!# Enable support for extended double precision +#ifndef WITH_XDP +#define WITH_XDP 0 +#endif + +!> Provides a light-weight procedural testing framework for Fortran projects. +!> +!> Testsuites are defined by a [[collect_interface]] returning a set of +!> [[unittest_type]] objects. To create a new test use the [[new_unittest]] +!> constructor, which requires a test identifier and a procedure with a +!> [[test_interface]] compatible signature. The error status is communicated +!> by the allocation status of an [[error_type]]. +!> +!> The necessary boilerplate code to setup the test entry point is just +!> +!>```fortran +!>program tester +!> use, intrinsic :: iso_fortran_env, only : error_unit +!> use testdrive, only : run_testsuite, new_testsuite, testsuite_type +!> use test_suite1, only : collect_suite1 +!> use test_suite2, only : collect_suite2 +!> implicit none +!> integer :: stat, is +!> type(testsuite_type), allocatable :: testsuites(:) +!> character(len=*), parameter :: fmt = '("#", *(1x, a))' +!> +!> stat = 0 +!> +!> testsuites = [ & +!> new_testsuite("suite1", collect_suite1), & +!> new_testsuite("suite2", collect_suite2) & +!> ] +!> +!> do is = 1, size(testsuites) +!> write(error_unit, fmt) "Testing:", testsuites(is)%name +!> call run_testsuite(testsuites(is)%collect, error_unit, stat) +!> end do +!> +!> if (stat > 0) then +!> write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" +!> error stop +!> end if +!> +!>end program tester +!>``` +!> +!> Every test is defined in a separate module using a ``collect`` function, which +!> is exported and added to the ``testsuites`` array in the test runner. +!> All test have a simple interface with just an allocatable [[error_type]] as +!> output to provide the test results. +!> +!>```fortran +!>module test_suite1 +!> use testdrive, only : new_unittest, unittest_type, error_type, check +!> implicit none +!> private +!> +!> public :: collect_suite1 +!> +!>contains +!> +!>!> Collect all exported unit tests +!>subroutine collect_suite1(testsuite) +!> !> Collection of tests +!> type(unittest_type), allocatable, intent(out) :: testsuite(:) +!> +!> testsuite = [ & +!> new_unittest("valid", test_valid), & +!> new_unittest("invalid", test_invalid, should_fail=.true.) & +!> ] +!> +!>end subroutine collect_suite1 +!> +!>subroutine test_valid(error) +!> type(error_type), allocatable, intent(out) :: error +!> ! ... +!>end subroutine test_valid +!> +!>subroutine test_invalid(error) +!> type(error_type), allocatable, intent(out) :: error +!> ! ... +!>end subroutine test_invalid +!> +!>end module test_suite1 +!>``` +!> +!> For an example setup checkout the ``test/`` directory in this project. +module testdrive + use, intrinsic :: iso_fortran_env, only : error_unit + implicit none + private + + public :: run_testsuite, run_selected, new_unittest, new_testsuite + public :: select_test, select_suite + public :: unittest_type, testsuite_type, error_type + public :: check, test_failed, skip_test + public :: test_interface, collect_interface + public :: get_argument, get_variable, to_string + + + !> Single precision real numbers + integer, parameter :: sp = selected_real_kind(6) + + !> Double precision real numbers + integer, parameter :: dp = selected_real_kind(15) + +#if WITH_XDP + !> Extended double precision real numbers + integer, parameter :: xdp = selected_real_kind(18) +#endif + +#if WITH_QP + !> Quadruple precision real numbers + integer, parameter :: qp = selected_real_kind(33) +#endif + + !> Char length for integers + integer, parameter :: i1 = selected_int_kind(2) + + !> Short length for integers + integer, parameter :: i2 = selected_int_kind(4) + + !> Length of default integers + integer, parameter :: i4 = selected_int_kind(9) + + !> Long length for integers + integer, parameter :: i8 = selected_int_kind(18) + + !> Error code for success + integer, parameter :: success = 0 + + !> Error code for failure + integer, parameter :: fatal = 1 + + !> Error code for skipped test + integer, parameter :: skipped = 77 + + + !> Error message + type :: error_type + + !> Error code + integer :: stat = success + + !> Payload of the error + character(len=:), allocatable :: message + + contains + + !> Escalate uncaught errors + final :: escalate_error + + end type error_type + + + interface check + module procedure :: check_stat + module procedure :: check_logical + module procedure :: check_float_sp + module procedure :: check_float_dp +#if WITH_XDP + module procedure :: check_float_xdp +#endif +#if WITH_QP + module procedure :: check_float_qp +#endif + module procedure :: check_float_exceptional_sp + module procedure :: check_float_exceptional_dp +#if WITH_XDP + module procedure :: check_float_exceptional_xdp +#endif +#if WITH_QP + module procedure :: check_float_exceptional_qp +#endif + module procedure :: check_complex_sp + module procedure :: check_complex_dp +#if WITH_XDP + module procedure :: check_complex_xdp +#endif +#if WITH_QP + module procedure :: check_complex_qp +#endif + module procedure :: check_complex_exceptional_sp + module procedure :: check_complex_exceptional_dp +#if WITH_XDP + module procedure :: check_complex_exceptional_xdp +#endif +#if WITH_QP + module procedure :: check_complex_exceptional_qp +#endif + module procedure :: check_int_i1 + module procedure :: check_int_i2 + module procedure :: check_int_i4 + module procedure :: check_int_i8 + module procedure :: check_bool + module procedure :: check_string + end interface check + + + interface to_string + module procedure :: integer_i1_to_string + module procedure :: integer_i2_to_string + module procedure :: integer_i4_to_string + module procedure :: integer_i8_to_string + module procedure :: real_sp_to_string + module procedure :: real_dp_to_string +#if WITH_XDP + module procedure :: real_xdp_to_string +#endif +#if WITH_QP + module procedure :: real_qp_to_string +#endif + module procedure :: complex_sp_to_string + module procedure :: complex_dp_to_string +#if WITH_XDP + module procedure :: complex_xdp_to_string +#endif +#if WITH_QP + module procedure :: complex_qp_to_string +#endif + end interface to_string + + + !> Implementation of check for not a number value, in case a compiler does not + !> provide the IEEE intrinsic ``ieee_is_nan`` (currently this is Intel oneAPI on MacOS) + interface is_nan + module procedure :: is_nan_sp + module procedure :: is_nan_dp +#if WITH_XDP + module procedure :: is_nan_xdp +#endif +#if WITH_QP + module procedure :: is_nan_qp +#endif + end interface is_nan + + + abstract interface + !> Entry point for tests + subroutine test_interface(error) + import :: error_type + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + end subroutine test_interface + end interface + + + !> Declaration of a unit test + type :: unittest_type + + !> Name of the test + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(test_interface), pointer, nopass :: test => null() + + !> Whether test is supposed to fail + logical :: should_fail = .false. + + end type unittest_type + + + abstract interface + !> Collect all tests + subroutine collect_interface(testsuite) + import :: unittest_type + + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + end subroutine collect_interface + end interface + + + !> Collection of unit tests + type :: testsuite_type + + !> Name of the testsuite + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(collect_interface), pointer, nopass :: collect => null() + + end type testsuite_type + + + character(len=*), parameter :: fmt = '(1x, *(1x, a))' + + +contains + + + !> Driver for testsuite + recursive subroutine run_testsuite(collect, unit, stat, parallel) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + !> Run the tests in parallel + logical, intent(in), optional :: parallel + + type(unittest_type), allocatable :: testsuite(:) + integer :: it + logical :: parallel_ + + parallel_ = .true. + if(present(parallel)) parallel_ = parallel + + call collect(testsuite) + + !$omp parallel do schedule(dynamic) shared(testsuite, unit) reduction(+:stat) & + !$omp if (parallel_) + do it = 1, size(testsuite) + !$omp critical(testdrive_testsuite) + write(unit, '(1x, 3(1x, a), 1x, "(", i0, "/", i0, ")")') & + & "Starting", testsuite(it)%name, "...", it, size(testsuite) + !$omp end critical(testdrive_testsuite) + call run_unittest(testsuite(it), unit, stat) + end do + + end subroutine run_testsuite + + + !> Driver for selective testing + recursive subroutine run_selected(collect, name, unit, stat) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Name of the selected test + character(len=*), intent(in) :: name + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + type(unittest_type), allocatable :: testsuite(:) + integer :: it + + call collect(testsuite) + + it = select_test(testsuite, name) + + if (it > 0 .and. it <= size(testsuite)) then + call run_unittest(testsuite(it), unit, stat) + else + write(unit, fmt) "Available tests:" + do it = 1, size(testsuite) + write(unit, fmt) "-", testsuite(it)%name + end do + stat = -huge(it) + end if + + end subroutine run_selected + + + !> Run a selected unit test + recursive subroutine run_unittest(test, unit, stat) + + !> Unit test + type(unittest_type), intent(in) :: test + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + type(error_type), allocatable :: error + character(len=:), allocatable :: message + + call test%test(error) + if (.not.test_skipped(error)) then + if (allocated(error) .neqv. test%should_fail) stat = stat + 1 + end if + call make_output(message, test, error) + !$omp critical(testdrive_testsuite) + write(unit, '(a)') message + !$omp end critical(testdrive_testsuite) + if (allocated(error)) then + call clear_error(error) + end if + + end subroutine run_unittest + + + pure function test_skipped(error) result(is_skipped) + + !> Error handling + type(error_type), intent(in), optional :: error + + !> Test was skipped + logical :: is_skipped + + is_skipped = .false. + if (present(error)) then + is_skipped = error%stat == skipped + end if + + end function test_skipped + + + !> Create output message for test (this procedure is pure and therefore cannot launch tests) + pure subroutine make_output(output, test, error) + + !> Output message for display + character(len=:), allocatable, intent(out) :: output + + !> Unit test + type(unittest_type), intent(in) :: test + + !> Error handling + type(error_type), intent(in), optional :: error + + character(len=:), allocatable :: label + character(len=*), parameter :: indent = repeat(" ", 7) // repeat(".", 3) // " " + + if (test_skipped(error)) then + output = indent // test%name // " [SKIPPED]" & + & // new_line("a") // " Message: " // error%message + return + end if + + if (present(error) .neqv. test%should_fail) then + if (test%should_fail) then + label = " [UNEXPECTED PASS]" + else + label = " [FAILED]" + end if + else + if (test%should_fail) then + label = " [EXPECTED FAIL]" + else + label = " [PASSED]" + end if + end if + output = indent // test%name // label + if (present(error)) then + output = output // new_line("a") // " Message: " // error%message + end if + end subroutine make_output + + + !> Select a unit test from all available tests + function select_test(tests, name) result(pos) + + !> Name identifying the test suite + character(len=*), intent(in) :: name + + !> Available unit tests + type(unittest_type) :: tests(:) + + !> Selected test suite + integer :: pos + + integer :: it + + pos = 0 + do it = 1, size(tests) + if (name == tests(it)%name) then + pos = it + exit + end if + end do + + end function select_test + + + !> Select a test suite from all available suites + function select_suite(suites, name) result(pos) + + !> Name identifying the test suite + character(len=*), intent(in) :: name + + !> Available test suites + type(testsuite_type) :: suites(:) + + !> Selected test suite + integer :: pos + + integer :: it + + pos = 0 + do it = 1, size(suites) + if (name == suites(it)%name) then + pos = it + exit + end if + end do + + end function select_suite + + + !> Register a new unit test + function new_unittest(name, test, should_fail) result(self) + + !> Name of the test + character(len=*), intent(in) :: name + + !> Entry point for the test + procedure(test_interface) :: test + + !> Whether test is supposed to error or not + logical, intent(in), optional :: should_fail + + !> Newly registered test + type(unittest_type) :: self + + self%name = name + self%test => test + if (present(should_fail)) self%should_fail = should_fail + + end function new_unittest + + + !> Register a new testsuite + function new_testsuite(name, collect) result(self) + + !> Name of the testsuite + character(len=*), intent(in) :: name + + !> Entry point to collect tests + procedure(collect_interface) :: collect + + !> Newly registered testsuite + type(testsuite_type) :: self + + self%name = name + self%collect => collect + + end function new_testsuite + + + subroutine check_stat(error, stat, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Status of operation + integer, intent(in) :: stat + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (stat /= success) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Non-zero exit code encountered", more) + end if + end if + + end subroutine check_stat + + + subroutine check_logical(error, expression, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Result of logical operator + logical, intent(in) :: expression + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (.not.expression) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Condition not fullfilled", more) + end if + end if + + end subroutine check_logical + + + subroutine check_float_dp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(dp), intent(in) :: actual + + !> Expected floating point value + real(dp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(dp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(dp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_dp + + + subroutine check_float_exceptional_dp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(dp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_dp + + + subroutine check_float_sp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(sp), intent(in) :: actual + + !> Expected floating point value + real(sp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(sp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(sp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_sp + + + subroutine check_float_exceptional_sp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(sp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_sp + + +#if WITH_XDP + subroutine check_float_xdp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(xdp), intent(in) :: actual + + !> Expected floating point value + real(xdp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(xdp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(xdp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_xdp + + + subroutine check_float_exceptional_xdp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(xdp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_xdp +#endif + + +#if WITH_QP + subroutine check_float_qp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(qp), intent(in) :: actual + + !> Expected floating point value + real(qp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(qp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(qp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_qp + + + subroutine check_float_exceptional_qp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(qp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_qp +#endif + + + subroutine check_complex_dp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(dp), intent(in) :: actual + + !> Expected floating point value + complex(dp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(dp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(dp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_dp + + + subroutine check_complex_exceptional_dp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(dp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_dp + + + subroutine check_complex_sp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(sp), intent(in) :: actual + + !> Expected floating point value + complex(sp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(sp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(sp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_sp + + + subroutine check_complex_exceptional_sp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(sp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_sp + + +#if WITH_XDP + subroutine check_complex_xdp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(xdp), intent(in) :: actual + + !> Expected floating point value + complex(xdp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(xdp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(xdp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_xdp + + + subroutine check_complex_exceptional_xdp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(xdp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_xdp +#endif + + +#if WITH_QP + subroutine check_complex_qp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(qp), intent(in) :: actual + + !> Expected floating point value + complex(qp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(qp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(qp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_qp + + + subroutine check_complex_exceptional_qp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(qp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_qp +#endif + + + subroutine check_int_i1(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i1), intent(in) :: actual + + !> Expected integer value + integer(i1), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i1 + + + subroutine check_int_i2(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i2), intent(in) :: actual + + !> Expected integer value + integer(i2), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i2 + + + subroutine check_int_i4(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i4), intent(in) :: actual + + !> Expected integer value + integer(i4), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i4 + + + subroutine check_int_i8(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i8), intent(in) :: actual + + !> Expected integer value + integer(i8), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i8 + + + subroutine check_bool(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found boolean value + logical, intent(in) :: actual + + !> Expected boolean value + logical, intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected .neqv. actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Logical value missmatch", & + "expected "//merge("T", "F", expected)//" but got "//merge("T", "F", actual), & + more) + end if + end if + + end subroutine check_bool + + + subroutine check_string(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found boolean value + character(len=*), intent(in) :: actual + + !> Expected boolean value + character(len=*), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Character value missmatch", & + "expected '"//expected//"' but got '"//actual//"'", & + more) + end if + end if + + end subroutine check_string + + + subroutine test_failed(error, message, more, and_more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> A detailed message describing the error + character(len=*), intent(in) :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Another line of error message + character(len=*), intent(in), optional :: and_more + + character(len=*), parameter :: skip = new_line("a") // repeat(" ", 11) + + allocate(error) + error%stat = fatal + + error%message = message + if (present(more)) then + error%message = error%message // skip // more + end if + if (present(and_more)) then + error%message = error%message // skip // and_more + end if + + end subroutine test_failed + + + !> A test is skipped because certain requirements are not met to run the actual test + subroutine skip_test(error, message, more, and_more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> A detailed message describing the error + character(len=*), intent(in) :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Another line of error message + character(len=*), intent(in), optional :: and_more + + call test_failed(error, message, more, and_more) + error%stat = skipped + + end subroutine skip_test + + + !> Obtain the command line argument at a given index + subroutine get_argument(idx, arg) + + !> Index of command line argument, range [0:command_argument_count()] + integer, intent(in) :: idx + + !> Command line argument + character(len=:), allocatable, intent(out) :: arg + + integer :: length, stat + + call get_command_argument(idx, length=length, status=stat) + if (stat /= success) return + + allocate(character(len=length) :: arg, stat=stat) + if (stat /= success) return + + if (length > 0) then + call get_command_argument(idx, arg, status=stat) + if (stat /= success) deallocate(arg) + end if + + end subroutine get_argument + + + !> Obtain the value of an environment variable + subroutine get_variable(var, val) + + !> Name of variable + character(len=*), intent(in) :: var + + !> Value of variable + character(len=:), allocatable, intent(out) :: val + + integer :: length, stat + + call get_environment_variable(var, length=length, status=stat) + if (stat /= success) return + + allocate(character(len=length) :: val, stat=stat) + if (stat /= success) return + + if (length > 0) then + call get_environment_variable(var, val, status=stat) + if (stat /= success) deallocate(val) + end if + + end subroutine get_variable + + + pure function integer_i1_to_string(val) result(string) + integer, parameter :: ik = i1 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i1_to_string + + + pure function integer_i2_to_string(val) result(string) + integer, parameter :: ik = i2 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i2_to_string + + + pure function integer_i4_to_string(val) result(string) + integer, parameter :: ik = i4 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i4_to_string + + + pure function integer_i8_to_string(val) result(string) + integer, parameter :: ik = i8 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i8_to_string + + + pure function real_sp_to_string(val) result(string) + real(sp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_sp_to_string + + + pure function real_dp_to_string(val) result(string) + real(dp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_dp_to_string + + +#if WITH_XDP + pure function real_xdp_to_string(val) result(string) + real(xdp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_xdp_to_string +#endif + + +#if WITH_QP + pure function real_qp_to_string(val) result(string) + real(qp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_qp_to_string +#endif + + + pure function complex_sp_to_string(val) result(string) + complex(sp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_sp_to_string + + + pure function complex_dp_to_string(val) result(string) + complex(dp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_dp_to_string + + +#if WITH_XDP + pure function complex_xdp_to_string(val) result(string) + complex(xdp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_xdp_to_string +#endif + + +#if WITH_QP + pure function complex_qp_to_string(val) result(string) + complex(qp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_qp_to_string +#endif + + + !> Clear error type after it has been handled. + subroutine clear_error(error) + + !> Error handling + type(error_type), intent(inout) :: error + + if (error%stat /= success) then + error%stat = success + end if + + if (allocated(error%message)) then + deallocate(error%message) + end if + + end subroutine clear_error + + + !> Finalizer of the error type, in case the error is not correctly cleared it will + !> be escalated at runtime in a fatal way + subroutine escalate_error(error) + + !> Error handling + type(error_type), intent(inout) :: error + + if (error%stat /= success) then + write(error_unit, '(a)') "[Fatal] Uncaught error" + if (allocated(error%message)) then + write(error_unit, '(a, 1x, i0, *(1x, a))') & + "Code:", error%stat, "Message:", error%message + end if + error stop + end if + + end subroutine escalate_error + + + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_sp(val) result(is_nan) + !> Value to check + real(sp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_sp + + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_dp(val) result(is_nan) + !> Value to check + real(dp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_dp + +#if WITH_XDP + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_xdp(val) result(is_nan) + !> Value to check + real(xdp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_xdp +#endif + +#if WITH_QP + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_qp(val) result(is_nan) + !> Value to check + real(qp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_qp +#endif + + +end module testdrive diff --git a/unit_tests/test-drive/testdrive_version.f90 b/unit_tests/test-drive/testdrive_version.f90 new file mode 100644 index 0000000000..1c6391b969 --- /dev/null +++ b/unit_tests/test-drive/testdrive_version.f90 @@ -0,0 +1,63 @@ +! This file is part of test-drive. +! SPDX-Identifier: Apache-2.0 OR MIT +! +! Licensed under either of Apache License, Version 2.0 or MIT license +! at your option; you may not use this file except in compliance with +! the License. +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +module testdrive_version + implicit none + private + + public :: testdrive_version_string, testdrive_version_compact + public :: get_testdrive_version + + + !> String representation of the test-drive version + character(len=*), parameter :: testdrive_version_string = "0.4.0" + + !> Numeric representation of the test-drive version + integer, parameter :: testdrive_version_compact(3) = [0, 4, 0] + + +contains + + +!> Getter function to retrieve test-drive version +subroutine get_testdrive_version(major, minor, patch, string) + + !> Major version number of the test-drive version + integer, intent(out), optional :: major + + !> Minor version number of the test-drive version + integer, intent(out), optional :: minor + + !> Patch version number of the test-drive version + integer, intent(out), optional :: patch + + !> String representation of the test-drive version + character(len=:), allocatable, intent(out), optional :: string + + if (present(major)) then + major = testdrive_version_compact(1) + end if + if (present(minor)) then + minor = testdrive_version_compact(2) + end if + if (present(patch)) then + patch = testdrive_version_compact(3) + end if + if (present(string)) then + string = testdrive_version_string + end if + +end subroutine get_testdrive_version + + +end module testdrive_version diff --git a/unit_tests/test_SUBROUTINE.F90 b/unit_tests/test_SUBROUTINE.F90 deleted file mode 100644 index 01807ab051..0000000000 --- a/unit_tests/test_SUBROUTINE.F90 +++ /dev/null @@ -1,89 +0,0 @@ -module test_SUBROUTINE - - use pFUnit_mod - use NWTC_IO - ! use MODULE ! Import the module that will be tested here. - - implicit none - - real(ReKi) :: tolerance = 1e-14 - character(1024) :: testname - -contains - - ! Test branches - ! - branch 1 - ! - branch 2 - ! - branch 3 - - ! Note that this module is *not* conforming Fortran code. - ! This is passed through a Python preprocessor included with pFUnit which parses - ! pFUnit directives like `@test` and `@assertEqual` to generate proper Fortran code. - - @test - subroutine test_branch1() - - ! Describe this test. - ! What is the expected result from the tested subroutine? - ! Why is the expected result the result that is expected? - - real(ReKi) :: zero = 0.0 - real(ReKi) :: test_result - integer(IntKi) :: error_status - - testname = "Branch 1" - expected = 0.0 - - ! Assume SUBROUTINE( intent(in), intent(out), intent(out) ) - call SUBROUTINE(zero, test_result, error_status) - - @assertEqual(expected, test_result, tolerance, testname) - @assertEqual(0, error_status, tolerance, testname) - - end subroutine - - @test - subroutine test_branch2() - - ! Describe this test. - ! What is the expected result from the tested subroutine? - ! Why is the expected result the result that is expected? - - real(ReKi) :: pi = 3.14159 - real(ReKi) :: test_result - integer(IntKi) :: error_status - - testname = "Branch 2" - expected = 0.0 - - ! Assume SUBROUTINE( intent(in), intent(out), intent(out) ) - call SUBROUTINE(pi, test_result, error_status) - - @assertEqual(expected, test_result, tolerance, testname) - @assertEqual(0, error_status, tolerance, testname) - - end subroutine - - @test - subroutine test_branch3() - - ! Describe this test. - ! What is the expected result from the tested subroutine? - ! Why is the expected result the result that is expected? - - real(ReKi) :: pi_by_2 = 1.57079 - real(ReKi) :: test_result - integer(IntKi) :: error_status - - testname = "Branch 3" - expected = 99.9 - - ! Assume SUBROUTINE( intent(in), intent(out), intent(out) ) - call SUBROUTINE(pi_by_2, test_result, error_status) - - @assertEqual(expected, test_result, tolerance, testname) - @assertEqual(0, error_status, tolerance, testname) - - end subroutine - -end module diff --git a/unit_tests/version/CMakeLists.txt b/unit_tests/version/CMakeLists.txt deleted file mode 100644 index a974369718..0000000000 --- a/unit_tests/version/CMakeLists.txt +++ /dev/null @@ -1,60 +0,0 @@ -# -# Copyright 2017 National Renewable Energy Laboratory -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# - -# Tell CMake not to look for this file to exist since its generated by pFUnit during compile -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "versioninfo") -set(module_directory "version") -set(module_library "versioninfolib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${build_testdirectory}/${module_directory}) - -set(testlist - VersionInfo_test_tools - test_VersionInfo_CheckArgs -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${Python_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - pfunit_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) -