ParaMonte Fortran 2.0.0
Parallel Monte Carlo and Machine Learning Library
See the latest version documentation.
pm_test.F90
Go to the documentation of this file.
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3!!!! !!!!
4!!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5!!!! !!!!
6!!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7!!!! !!!!
8!!!! This file is part of the ParaMonte library. !!!!
9!!!! !!!!
10!!!! LICENSE !!!!
11!!!! !!!!
12!!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13!!!! !!!!
14!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16
39
40!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
41
42module pm_test
43
44 use pm_io, only: display_type
45 use pm_kind, only: SK, IK, LK, RKG => RK
46 use, intrinsic :: iso_fortran_env, only: output_unit
48 use pm_parallelism, only: image_type
49 use pm_arrayResize, only: setResized
50 use pm_container, only: css_type
51 use pm_timer, only: timer_type
52 use pm_val2str, only: getStr
53 use pm_err, only: err_type
54
55 implicit none
56
57 private
58 public :: SK, IK, LK, test_type, setSummary
59
61 character(*, SK) , parameter :: NLC = new_line(SK_"a")
62 character(*, SK) , parameter :: MODULE_NAME = SK_"pm_test"
63 !integer(IK) , parameter :: TEST_COUNTER_LEN = 8_IK
64 integer(IK) , parameter :: TIME_FIELD_LEN = 9_IK
65 integer(IK) :: mv_testCounterOld
66 integer(IK) :: mv_testCounter
67 integer(IK) :: mv_nfail
68 integer(IK) :: mv_npass
69 type(css_type) , allocatable :: mv_failedTestFuncName(:)
70 character(:, SK) , allocatable :: mc_passedString
71 character(:, SK) , allocatable :: mc_failedString
72 logical(LK) :: mv_uninit = .true._LK
73 class(timer_type) , allocatable :: mv_timer
74 type(image_type) :: mv_image
76
92 type :: dir_type
93 character(:, SK) , allocatable :: inp
94 character(:, SK) , allocatable :: out
95 end type
96
97
113 type :: file_type
114 integer(IK) :: unit
115 character(:, SK) , allocatable :: path
116 end type
117
118 !type :: strSplit_type
119 ! integer(IK) , allocatable :: sindex(:,:)
120 ! character(:, SK) , allocatable :: val
121 !end type
122
123 !type :: subject_type
124 ! type(strSplit_type) :: name !< \public An object containing information about the name and its parts (separated by underscore) of the current test subject (a procedure, type, ...).
125 !end type
126
127 !type :: testFunc_type
128 ! character(:, SK) , allocatable :: id !< \public The current number (ID) of the test function for a given object to be tested.
129 ! character(:, SK) , allocatable :: name !< \public The name of the test function for the currently given object that is to be tested.
130 ! class(timer_type) , allocatable :: timer !< \public This timer is exclusively used to time test cases within a given test internally.
131 ! integer(IK) :: counter !< \public The counter for the test cases within a given test function for a given test subject.
132 !end type
133
134 !type :: current_type
135 ! integer(IK) :: counter !< \public The `protected` scalar object of type `integer` of default kind \IK, containing count of individual assertions made within a specified test function or test module.<br>
136 ! !! The procedure name is automatically extracted from the input procedure name to the [run](@ref pm_test::setTestFunc) method of the object of type [test_type](@ref pm_test::test_type).<br>
137 !end type
138
140 class(timer_type) , allocatable :: timer
141 character(:, SK) , allocatable :: name
142 end type
143
144 type, extends(scope_type) :: func_type
145 integer(IK) :: counter = 0_IK
147 character(:, SK) , allocatable :: id
152 end type
153
209 type :: test_type
210 integer(IK) , private :: counter = 0_IK
211 logical(LK) , private :: asserted = .true._LK
212 logical(LK) , public :: traceable
213 type(dir_type) , public :: dir
214 type(func_type) , public :: func
215 type(scope_type) , public :: host
216 type(display_type) , public :: disp
217 type(image_type) , public :: image
218 type(file_type) , public :: file
219 !type(err_type) , private :: err !< \private The `private` scalar of type [err_type](@ref pm_err::err_type) containing information about any errors hat may occur during the testing.<br>
220 contains
221 !procedure , pass :: openFile
222 procedure , pass :: summarize => setTestSummary
223 procedure , pass :: assert => setTestAsserted
224 procedure , pass :: run => setTestFunc
225 end type
226
227 interface test_type
228 module procedure :: test_typer
229 end interface
230
231!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
232
233contains
234
235!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
236
260 subroutine setInitial()
261#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
262 !DEC$ ATTRIBUTES DLLEXPORT :: setInitial
263#endif
264 ! set the mode of error handling to testing mode
265 !mv_isTestingMode = .true._LK
266 mv_uninit = .false._LK
267 mv_image = image_type()
268 mv_timer = timer_type()
269 mc_passedString = bright//fgreen//SK_"passed"//reset
270 mc_failedString = bright//fred //SK_"FAILED"//reset
271 mv_testCounterOld = 0_IK
272 mv_testCounter = 0_IK
273 mv_npass = 0_IK
274 mv_nfail = 0_IK
275 ! preallocate the names of failed tests.
276 call setResized(mv_failedTestFuncName, mv_nfail + 1_IK)
277 write(output_unit, "(*(g0,:,' '))")
278 end subroutine
279
280!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
281
307 subroutine setSummary()
308#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
309 !DEC$ ATTRIBUTES DLLEXPORT :: setSummary
310#endif
311 use pm_io, only: TABEQV
312 use pm_err, only: setAborted
314 real(RKG) :: percentageTestPassed
315 character(:, SK), allocatable :: msg, color
316 character(*), parameter :: format = "(*(g0,:,' '))"
317 integer(IK) :: ntotal, ifail, ndigit
318 if (mv_uninit) call setInitial()
319 ntotal = mv_npass + mv_nfail
320 percentageTestPassed = 0._RKG
321 if (ntotal /= 0_IK) percentageTestPassed = 100_IK * mv_npass / real(ntotal, RKG)
322 if (mv_image%is%first) then
323 msg = bright//fyellow//getStr(ntotal)//SK_" tests performed. "//reset
324 if (nint(percentageTestPassed, IK) == 0_IK) then
325 color = fred
326 else
327 color = fgreen
328 end if
329 msg = msg//bright//color//getStr(percentageTestPassed,SK_"(f0.2)")//SK_"% of "//getStr(ntotal)//SK_" tests passed. "//reset
330 if (0_IK < mv_nfail) then
331 color = fred
332 else
333 color = fgreen
334 end if
335 msg = msg//bright//color//getStr(mv_nfail, SK_"(g0)")//SK_" tests failed. "//reset
336 msg = msg//bright//fyellow//SK_"The total elapsed wall-clock time: "//getStr(mv_timer%time(since = mv_timer%start), SK_"(f0.6)")//SK_" seconds."//reset
337 write(output_unit, format) NLC//msg//NLC
338 ndigit = getCountDigit(mv_nfail)
339 if (mv_nfail > 0_IK) then
340 write(output_unit, format) NLC//bright//fred//SK_"The following tests FAILED:"//reset//NLC
341 do ifail = 1, mv_nfail
342 write(output_unit, format) bright//fred//TABEQV//adjustr(getStr(ifail, length = ndigit))//SK_") "//mv_failedTestFuncName(ifail)%val//reset
343 end do
344 write(output_unit, format) NLC//bright//fred//SK_"Errors occurred while running the ParaMonte tests."
345 write(output_unit, format) SK_"Please report this issue at: "//bright//fcyan//underlined//SK_"https://github.com/cdslaborg/paramonte/issues"//reset//NLC//NLC
346#if !CHECK_ENABLED
347 write(output_unit, format) NLC//bright//fred//SK_"To get information about the cause of failure, compile the library with FPP runtime checks enabled and rerun the tests."//reset//NLC
348#endif
349 end if
350 end if
351 !if (mv_nfail > 0_IK) !error stop !call setAborted()
352 call mv_image%finalize()
353 mv_uninit = .true._LK
354 end subroutine
355
356!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
357
412 function test_typer(host, inp, out, traceable) result(test)
413#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
414 !DEC$ ATTRIBUTES DLLEXPORT :: test_typer
415#endif
416 use pm_err, only: err_type, setAborted
418 character(*, SK), intent(in), optional :: host, inp, out
419 logical(LK), intent(in), optional :: traceable
420 type(test_type) :: test
421 if (mv_uninit) call setInitial()
422 test%image = mv_image
423 test%disp = display_type()
424 test%func%timer = timer_type()
425 test%host%timer = timer_type()
426 if (present(traceable)) then
427 test%traceable = traceable
428 else
429#if CHECK_ENABLED
430 test%traceable = .true._LK
431#else
432 test%traceable = .false._LK
433#endif
434 end if
435 if (present(host)) then
436 test%host%name = trim(adjustl(host))
437 else
438 test%host%name = SK_"@unknown_scope"
439 end if
440 if (present(inp)) then
441 test%dir%inp = inp
442 else
443 test%dir%inp = SK_"./input"
444 end if
445 if (present(out)) then
446 test%dir%out = out
447 else
448 test%dir%out = SK_"./output"
449 end if
450 ! mkdir the output directory if it does not exists.
451 if (test%image%is%first .and. .not. isDir(test%dir%out)) then
452 if (isFailedMakeDir(test%dir%out)) error stop MODULE_NAME//SK_"@test_typer(): Failed to generate the test module output directory: "//test%dir%out
453 end if
454 call test%image%sync()
455 end function
456
457!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
458
508 subroutine setTestFunc(self, getAssertion, name)
509#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
510 !DEC$ ATTRIBUTES DLLEXPORT :: setTestFunc
511#endif
512 use pm_strASCII, only: isStrInteger
513 procedure(logical(LK)) :: getAssertion
514 class(test_type), intent(inout) :: self
515 character(*, SK), intent(in), optional :: name
516 logical(LK) :: assertion
517 if (present(name)) then
518 self%func%name = trim(adjustl(name))
519 if (4_IK < len(self%func%name, IK)) then
520 if (self%func%name(1:5) == SK_"test_") self%func%name = self%func%name(6:)
521 end if
522 block
523 use pm_arrayFind, only: setLoc
524 integer(IK), allocatable :: loc(:)
525 integer(IK) :: nloc
526 call setResized(loc, 2_IK)
527 call setLoc(loc, nloc, self%func%name, SK_"_", blindness = 1_IK)
528 if (nloc == 0_IK) then
529 self%func%id = SK_"#1"
530 elseif (isStrInteger(self%func%name(loc(nloc) + 1 :))) then
531 self%func%id = SK_"#"//self%func%name(loc(nloc) + 1 :)
532 self%func%name = self%func%name(1 : loc(nloc) - 1)
533 else
534 self%func%id = SK_"#1"
535 self%func%name = name
536 end if
537 end block
538 else
539 self%func%id = SK_"#1"
540 self%func%name = SK_"unknown"
541 end if
542 self%counter = 0_IK
543 !self%func%name = SK_"Test_"//self%host%name(2:)//SK_"@"//trim(adjustl(name))
544 self%func%name = self%host%name//SK_"@"//trim(adjustl(self%func%name))
545 self%func%timer = timer_type()
546 assertion = getAssertion()
547 self%asserted = self%asserted .and. assertion
548 call self%assert(assertion)
549 self%func%counter = 0_IK
550 end subroutine
551
552!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
553
592 subroutine setTestAsserted(self, assertion, desc, line)
593#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
594 !DEC$ ATTRIBUTES DLLEXPORT :: setTestAsserted
595#endif
596 use pm_err, only: setAborted
597 use pm_arrayInit, only: getCoreHalo
598 logical(LK), intent(in) :: assertion
599 class(test_type), intent(inout) :: self
600 integer(IK), intent(in), optional :: line
601 character(*, SK), intent(in), optional :: desc
602 character(:, SK), allocatable :: statusMsg
603 character(:, SK), allocatable :: desc_def
604 character(:, SK), allocatable :: traceback
605 character(:, SK), allocatable :: assertionID
606 character(:, SK), allocatable :: errmsg
607 integer(IK) :: iid
608 self%func%timer%delta = self%func%timer%time(since = self%func%timer%start) - self%func%timer%clock
609 self%func%timer%clock = self%func%timer%time(since = self%func%timer%start)
610 self%func%counter = self%func%counter + 1_IK
611 if (present(desc)) then
612 desc_def = desc
613 else
614 desc_def = SK_"unavailable"
615 end if
616 if (present(line)) then
617 traceback = SK_"traceback test source line: "//getStr(line)
618 else
619 traceback = SK_""
620 end if
621 assertionID = self%func%name//self%func%id//SK_"-"//getStr(self%func%counter)//SK_" "
622 if (assertion) then
623 mv_npass = mv_npass + 1_IK
624 statusMsg = mc_passedString
625 else
626 mv_nfail = mv_nfail + 1_IK
627 statusMsg = mc_failedString
628 if (size(mv_failedTestFuncName, 1, IK) < mv_nfail) call setResized(mv_failedTestFuncName)
629 mv_failedTestFuncName(mv_nfail)%val = assertionID
630 end if
631 mv_testCounter = mv_testCounter + 1_IK
632 do iid = 1, self%image%count
633 if (iid == self%image%id) then
634 write(self%disp%unit, "(*(A))") & ! LCOV_EXCL_LINE
635 SK_"["//adjustr(getStr(mv_testCounter))//SK_"] testing "// & ! LCOV_EXCL_LINE
636 getCoreHalo(79_IK, assertionID, SK_".", 0_IK)//SK_" "//statusMsg// & ! LCOV_EXCL_LINE
637 SK_" in "//adjustr(getStr(self%func%timer%delta, SK_"(f0.4)", TIME_FIELD_LEN))// & ! LCOV_EXCL_LINE
638 SK_" out of "//adjustr(getStr(self%func%timer%clock, SK_"(f0.4)", TIME_FIELD_LEN))// & ! LCOV_EXCL_LINE
639 SK_" seconds on image "//getStr(self%image%id)
640 end if
641#if CAF_ENABLED || MPI_ENABLED
642 block
643 integer :: stat
644 call execute_command_line(" ", cmdstat = stat)
645 flush(output_unit)
646 call self%image%sync()
647 end block
648#endif
649 end do
650 call self%func%timer%wait(0.0001_RKG)
651 if (self%traceable .and. .not. assertion) then
652 errmsg = SK_"The test assertion is FALSE."//NLC//SK_"The assertion description: "//trim(adjustl(desc_def))//NLC//traceback ! LCOV_EXCL_LINE
653 call setAborted(msg = errmsg, prefix = SK_"ParaMonteTest"//self%func%name) ! LCOV_EXCL_LINE
654 error stop ! LCOV_EXCL_LINE
655 end if
656 end subroutine
657
658!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
659
682 subroutine setTestSummary(self)
683#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
684 !DEC$ ATTRIBUTES DLLEXPORT :: setTestSummary
685#endif
686 use pm_arrayInit, only: getCoreHalo
688 class(test_type), intent(inout) :: self
689 character(:, SK), allocatable :: statusMsg
690 if (self%asserted) then
691 statusMsg = mc_passedString
692 else
693 statusMsg = mc_failedString
694 end if
695 self%host%timer%delta = self%host%timer%time(since = self%host%timer%start)
696 write(self%disp%unit, "(*(g0,:,' '))") bright//fyellow// & ! LCOV_EXCL_LINE
697 SK_"["//adjustr(getStr(mv_testCounter - mv_testCounterOld, length = getCountDigit(mv_testCounter)))//SK_"] testing "// & ! LCOV_EXCL_LINE
698 getCoreHalo(79_IK, self%host%name//SK_" ", SK_".", 0_IK)//SK_" "//statusMsg// & ! LCOV_EXCL_LINE
699 SK_" in "//adjustr(getStr(self%host%timer%delta, SK_"(f0.4)", TIME_FIELD_LEN))// & ! LCOV_EXCL_LINE
700 SK_" out of "//adjustr(getStr(mv_timer%time(since = mv_timer%start), SK_"(f0.4)", TIME_FIELD_LEN))// & ! LCOV_EXCL_LINE
701 SK_" seconds on image "//getStr(self%image%id)//reset
702 mv_testCounterOld = mv_testCounter
703 call self%image%sync()
704 end subroutine
705
706!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
707
708#if 0
709
710 function openFile(self, path, label, status, position) result(file)
711 class(test_type), intent(in) :: self
712 character(*, SK), intent(in), optional :: path, label, status, position
713 character(:, SK), allocatable :: prefix_def, status_def, position_def
714 type(file_type) :: file
715 if (present(position)) then
716 position_def = position
717 else
718 position_def = SK_"asis"
719 end if
720 if (present(status)) then
721 status_def = status
722 else
723 status_def = SK_"unknown"
724 end if
725 if (present(path)) then
726 file%path = path
727 else
728 if (present(label)) then
729 prefix_def = SK_"@"//label
730 else
731 prefix_def = SK_""
732 end if
733 file%path = self%dir%out//SK_"/"//self%func%name//prefix_def//SK_"@"//getStr(self%image%id)//SK_".txt"
734 end if
735 !if (getStrLower(position_def)=="append") status_def = SK_"old"
736#if INTEL_ENABLED && WINDOWS_ENABLED
737#define SHARED, shared
738#else
739#define SHARED
740#endif
741 open(file = file%path, newunit = file%unit, status = status_def, position = position_def SHARED)
742#undef SHARED
743 end function
744
745!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
746
748 ! Return the negative natural logarithm of MVN distribution evaluated at the input vector `Point` of length `ndim`.
749 function getLogFuncMVN(ndim,Point) result(logFunc) BIND_C
750 implicit none
751 integer(IK) , intent(in) :: ndim
752 real(RKG) , intent(in) :: Point(ndim)
753 real(RKG) :: logFunc
754#if CFI_ENABLED
755 value :: ndim
756#endif
757 real(RKG) , parameter :: LOG_INVERSE_SQRT_TWO_PI = log(1._RKG / sqrt(2._RKG * acos(-1._RKG)))
758
759 !block
760 ! use pm_sysShell, only: sleep
761 ! use pm_err, only: err_type
762 ! type(err_type) :: err
763 ! call sleep(seconds=5000.e-6_RKG,err=err)
764 !end block
765
766 !block
767 ! real(RKG), allocatable :: unifrnd(:,:)
768 ! allocate(unifrnd(200,20))
769 ! call random_number(unifrnd)
770 ! logFunc = sum(unifrnd) - 0.5_RKG * sum(Point**2) - sum(unifrnd)
771 ! deallocate(unifrnd)
772 !end block
773
774 logFunc = ndim * LOG_INVERSE_SQRT_TWO_PI - 0.5_RKG * sum(Point**2_IK)
775
776 !block
777 ! integer(IK), parameter :: nmode = 2_IK
778 ! real(RKG):: LogAmplitude(nmode), mean(nmode), invCov(nmode), logSqrtDetInvCovMat(nmode)
779 ! LogAmplitude = [1._RKG, 1._RKG]
780 ! mean = [0._RKG, 7._RKG]
781 ! invCov = [1._RKG,1._RKG]
782 ! logSqrtDetInvCovMat = [1._RKG,1._RKG]
783 ! logFunc = getLogProbGausMix ( nmode = 2_IK &
784 ! , nd = 1_IK &
785 ! , np = 1_IK &
786 ! , LogAmplitude = LogAmplitude &
787 ! , mean = mean &
788 ! , invCov = invCov &
789 ! , logSqrtDetInvCovMat = logSqrtDetInvCovMat &
790 ! , Point = Point(1) &
791 ! )
792 !end block
793
794 end function getLogFuncMVN
795
796!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
797
800 function getLogFuncBanana2D(ndim,Point) result(logFunc) BIND_C
804 implicit none
805 integer(IK) , intent(in) :: ndim
806 real(RKG) , intent(in) :: Point(ndim)
807 real(RKG) :: logFunc
808#if CFI_ENABLED
809 value :: ndim
810#endif
811 integer(IK) , parameter :: NPAR = 2_IK ! sum(Banana,gaussian) normalization factor
812 real(RKG) , parameter :: normfac = 0.3_RKG ! 0.6_RKG ! sum(Banana,gaussian) normalization factor
813 real(RKG) , parameter :: lognormfac = log(normfac) ! sum(Banana,gaussian) normalization factor
814 real(RKG) , parameter :: a = 0.7_RKG, b = 1.5_RKG ! parameters of Banana function
815 real(RKG) , parameter :: MeanB(NPAR) = [ -5.0_RKG , 0._RKG ] ! mean vector of Banana function
816 real(RKG) , parameter :: MeanG(NPAR) = [ 3.5_RKG , 0._RKG ] ! mean vector of Gaussian function
817 real(RKG) , parameter :: CovMatB(NPAR,NPAR) = reshape([0.25_RKG,0._RKG,0._RKG,0.81_RKG],shape=shape(CovMatB)) ! Covariance matrix of Banana function
818 real(RKG) , parameter :: CovMatG(NPAR,NPAR) = reshape([0.15_RKG,0._RKG,0._RKG,0.15_RKG],shape=shape(CovMatB)) ! Covariance matrix of Gaussian function
819 real(RKG) , parameter :: InvCovMatB(NPAR,NPAR) = reshape([4._RKG,0._RKG,0._RKG,1.23456790123457_RKG],shape=shape(InvCovMatB)) ! Inverse Covariance matrix of Banana function
820 real(RKG) , parameter :: InvCovMatG(NPAR,NPAR) = reshape([6.66666666666667_RKG,0._RKG,0._RKG,6.66666666666667_RKG],shape=shape(InvCovMatG)) ! Inverse Covariance matrix of Gaussian function
821 real(RKG) , parameter :: logSqrtDetInvCovB = log(sqrt(4.93827160493827_RKG)) ! Determinant of the Inverse Covariance matrix of Banana function
822 real(RKG) , parameter :: logSqrtDetInvCovG = log(sqrt(44.4444444444445_RKG)) ! Determinant of the Inverse Covariance matrix of Gaussian function
823 real(RKG) :: PointSkewed(NPAR) ! transformed parameters that transform the Gaussian to the Banana function
824 real(RKG) :: LogProb(2) ! logProbMVN, logProbBanana
825
826 PointSkewed(1) = -Point(1)
827 PointSkewed(2) = +Point(2)
828
829 ! Gaussian function
830
831 LogProb(1) = lognormfac + getMultiNormLogPDF(PointSkewed, MeanG, InvCovMatG, getMultiNormLogPDFNF(ndim, logSqrtDetInvCovG)) ! logProbMVN
832
833 ! Do variable transformations for the Skewed-Gaussian (banana) function.
834
835 PointSkewed(2) = a * PointSkewed(2)
836 PointSkewed(1) = PointSkewed(1)/a - b*(PointSkewed(2)**2 + a**2)
837
838 ! Banana function
839
840 LogProb(2) = lognormfac + getMultiNormLogPDF(PointSkewed, MeanB, InvCovMatB, getMultiNormLogPDFNF(ndim, logSqrtDetInvCovB)) ! logProbBanana
841
842 !MeanBnew(2) = a * MeanBnew(2)
843 !MeanBnew(1) = MeanBnew(1)/a - b*(MeanBnew(2)**2 + a**2)
844
845 !logFunc = LogProb(2)
846 !logFunc = lognormfac + LogProb(1)
847 logFunc = getLogSumExp(LogProb, maxval(LogProb))
848
849 end function getLogFuncBanana2D
850
851!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
852
857 function getLogFuncEggBox2D(ndim,Point) result(logFunc) BIND_C
858 integer(IK) , intent(in) :: ndim
859 real(RKG) , intent(in) :: Point(ndim)
860 real(RKG) :: logFunc
861 real(RKG) , parameter :: PI = acos(-1._RKG)
862#if CFI_ENABLED
863 value :: ndim
864#endif
865 !logFunc = (2._RKG + cos(0.5_RKG*Point(1)) * cos(0.5_RKG*Point(2)) )**5_IK
866 logFunc = (2._RKG + cos(5_IK * PI * Point(1) - 2.5_RKG * PI) * cos(5_IK * PI * Point(2) - 2.5_RKG * PI)) ** 5.0
867 end function getLogFuncEggBox2D
869
870!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
871#endif
872
873end module pm_test ! LCOV_EXCL_LINE
Return an allocatable array containing the indices of the locations within the input array where the ...
Generate and return an array of specified rank and shape of arbitrary intrinsic type and kind with it...
Allocate or resize (shrink or expand) an input allocatable scalar string or array of rank 1....
Generate and return the natural logarithm of the normalization coefficient of the Probability Density...
Generate and return the natural logarithm of the Probability Density Function (PDF) of the MultiVaria...
Write the input string in the format of a fatal error to the output, then call error stop or return t...
Definition: pm_err.F90:2436
Generate and return the natural logarithm of the sum of the exponential of the input array robustly (...
Generate and return the number of digits in the input integer.
Generate and return .true. if all characters of the input string collectively represent an integer.
Generate and return .true. is the input path is an extant system directory, otherwise return ....
Generate and return .true. if the attempt to create the requested directory path fails,...
Generate and return the conversion of the input value to an output Fortran string,...
Definition: pm_val2str.F90:167
This module contains procedures and generic interfaces for finding locations of a pattern in arrays o...
This module contains procedures and generic interfaces for efficient initialization of arbitrary rect...
This module contains procedures and generic interfaces for resizing allocatable arrays of various typ...
This module contains the derived types for generating allocatable containers of scalar,...
This module contains classes and procedures for computing various statistical quantities related to t...
This module contains classes and procedures for reporting and handling errors.
Definition: pm_err.F90:52
This module contains classes and procedures for input/output (IO) or generic display operations on st...
Definition: pm_io.F90:252
type(display_type) disp
This is a scalar module variable an object of type display_type for general display.
Definition: pm_io.F90:11393
character(*, SK), parameter TABEQV
The scalar character of default kind SK of len = 4 representing the default string that is used in pl...
Definition: pm_io.F90:343
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
Definition: pm_kind.F90:268
integer, parameter RK
The default real kind in the ParaMonte library: real64 in Fortran, c_double in C-Fortran Interoperati...
Definition: pm_kind.F90:543
integer, parameter LK
The default logical kind in the ParaMonte library: kind(.true.) in Fortran, kind(....
Definition: pm_kind.F90:541
integer, parameter IK
The default integer kind in the ParaMonte library: int32 in Fortran, c_int32_t in C-Fortran Interoper...
Definition: pm_kind.F90:540
integer, parameter SK
The default character kind in the ParaMonte library: kind("a") in Fortran, c_char in C-Fortran Intero...
Definition: pm_kind.F90:539
This module contains the procedures and interfaces for computing the natural logarithm of the sum of ...
This module contains procedures and generic interfaces for converting numbers to different bases in d...
This module contains procedures and generic interfaces for facilitating parallel computations or comp...
This module contains procedures and generic interfaces for styling strings according for display on D...
Definition: pm_strANSI.F90:54
character(5, SK) fcyan
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
Definition: pm_strANSI.F90:95
character(5, SK) fgreen
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
Definition: pm_strANSI.F90:91
character(4, SK) bright
The ANSI escape code that makes subsequent texts appear bold/bright.
Definition: pm_strANSI.F90:68
character(4, SK) underlined
The ANSI escape code that makes subsequent texts appear underlined.
Definition: pm_strANSI.F90:71
character(4, SK) reset
The ANSI escape code that resets all previously specified ANSI text styles (same as [](pm_strANSI::en...
Definition: pm_strANSI.F90:87
character(5, SK) fyellow
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
Definition: pm_strANSI.F90:92
character(5, SK) fred
The scalar character of kind any supported by the processor (e.g., SK, SKA, SKD , or SKU) containing ...
Definition: pm_strANSI.F90:90
This module contains the uncommon and hardly representable ASCII characters as well as procedures for...
Definition: pm_strASCII.F90:61
This module contains classes and procedures for manipulating system file/folder paths.
Definition: pm_sysPath.F90:274
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
Definition: pm_test.F90:42
subroutine setTestSummary(self)
Summarize the suite of tests performed by the parent object of type test_type of this method.
Definition: pm_test.F90:683
subroutine setInitial()
Initialize the global module variables for testing.
Definition: pm_test.F90:261
subroutine setSummary()
Summarize the collection of all tests performed on all modules (or scoping units).
Definition: pm_test.F90:308
type(test_type) function test_typer(host, inp, out, traceable)
Generate and return an object of type test_type.
Definition: pm_test.F90:413
subroutine setTestFunc(self, getAssertion, name)
Run the input test function and verify the assertion returned by the test function.
Definition: pm_test.F90:509
subroutine setTestAsserted(self, assertion, desc, line)
Test the validity of the input assertion and if it does not hold,
Definition: pm_test.F90:593
This module contains the timer procedures and derived types to facilitate timing applications at runt...
Definition: pm_timer.F90:99
This module contains the generic procedures for converting values of different types and kinds to For...
Definition: pm_val2str.F90:58
This is the css_type type for generating instances of container of scalar of string objects.
This is the derived type for generating objects to gracefully and verbosely handle runtime unexpected...
Definition: pm_err.F90:157
Generate and return an object of type display_type.
Definition: pm_io.F90:10282
This is the image_type type for generating objects that contain information about the current image/p...
This is the module private derived type for constructing objects that contain the input and output di...
Definition: pm_test.F90:92
This is the module private derived type for constructing objects that contain the path to a file and ...
Definition: pm_test.F90:113
This is the derived type test_type for generating objects that facilitate testing of a series of proc...
Definition: pm_test.F90:209
This is the abstract base derived type that serves as a simple container template for other timer cla...
Definition: pm_timer.F90:212