Line data    Source code

       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             : 
      17             :     use pm_err, only: setNoted
      18             :     use pm_except, only: isNAN
      19             :     use pm_except, only: setNAN
      20             :     use pm_val2str, only: getStr
      21             :     use pm_arrayResize, only: setResized
      22             :     use pm_kind, only: SKC => SK, SK, IK, LK
      23             :     use pm_sampling_dram, only: specdram_type, astatdram_type, NL2, NL1
      24             :     use pm_sampling_scio, only: cfcdise_type
      25             : 
      26             :     implicit none
      27             : 
      28             :     character(*,SKC), parameter :: MODULE_NAME = SK_"@pm_sampling_dise"
      29             : 
      30             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      31             :     ! simulation declarations.
      32             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      33             : 
      34             :     type, abstract, extends(astatdram_type) :: astatdise_type
      35             :     end type
      36             : 
      37             :     type, extends(astatdise_type)           :: statdise_type
      38             :         type(cfcdise_type)                  :: cfc
      39             :     end type
      40             : 
      41             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      42             :     ! specification declarations.
      43             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      44             : 
      45             :     type, extends(specdram_type)            :: specdise_type
      46             :     contains
      47             :         procedure, pass, private            :: sanitize
      48             :         procedure, pass, private            :: report
      49             :         procedure, pass, public             :: set
      50             :     end type
      51             : 
      52             :     interface specdise_type
      53             :         module procedure :: construct
      54             :     end interface
      55             : 
      56             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      57             : 
      58             : contains
      59             : 
      60             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      61             : 
      62           0 :     subroutine killMeAlreadyCMake1_RK5(); use pm_sampling_scio_RK5, only: RKC; end subroutine
      63           0 :     subroutine killMeAlreadyCMake1_RK4(); use pm_sampling_scio_RK4, only: RKC; end subroutine
      64           0 :     subroutine killMeAlreadyCMake1_RK3(); use pm_sampling_scio_RK3, only: RKC; end subroutine
      65           0 :     subroutine killMeAlreadyCMake1_RK2(); use pm_sampling_scio_RK2, only: RKC; end subroutine
      66           0 :     subroutine killMeAlreadyCMake1_RK1(); use pm_sampling_scio_RK1, only: RKC; end subroutine
      67             : 
      68           0 :     subroutine killMeAlreadyCMake2_RK5(); use pm_sampling_dram_RK5, only: RKC; end subroutine
      69           0 :     subroutine killMeAlreadyCMake2_RK4(); use pm_sampling_dram_RK4, only: RKC; end subroutine
      70           0 :     subroutine killMeAlreadyCMake2_RK3(); use pm_sampling_dram_RK3, only: RKC; end subroutine
      71           0 :     subroutine killMeAlreadyCMake2_RK2(); use pm_sampling_dram_RK2, only: RKC; end subroutine
      72           0 :     subroutine killMeAlreadyCMake2_RK1(); use pm_sampling_dram_RK1, only: RKC; end subroutine
      73             : 
      74             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      75             : 
      76           0 :     function construct(modelr, method, ndim) result(spec)
      77             : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
      78             :         !DEC$ ATTRIBUTES DLLEXPORT :: construct
      79             : #endif
      80             :         use pm_kind, only: modelr_type
      81             :         type(modelr_type), intent(in) :: modelr
      82             :         character(*,SKC), intent(in) :: method
      83             :         integer(IK), intent(in) :: ndim
      84             :         type(specdise_type) :: spec
      85             : 
      86           0 :         spec%specdram_type = specdram_type(modelr, method, ndim)
      87             : 
      88           0 :     end function
      89             : 
      90             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      91             : 
      92           0 :     function set(spec, sampler) result(err)
      93             : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
      94             :         !DEC$ ATTRIBUTES DLLEXPORT :: set
      95             : #endif
      96             :         use pm_err, only: err_type
      97             :         use pm_sampling, only: paradise_type
      98             :         use pm_sampling, only: sampler_type
      99             :         class(specdise_type), intent(inout) :: spec
     100             :         class(sampler_type), intent(in), optional :: sampler
     101             :         type(err_type) :: err
     102             : 
     103             :         select type(sampler)
     104             :         type is (paradise_type)
     105             : 
     106           0 :             err = spec%specdram_type%set(sampler%paramcmc_type)
     107           0 :             if (err%occurred) return
     108             : 
     109             :             ! open output files, report and sanitize.
     110             : 
     111           0 :             if (spec%image%is%leader) call spec%report() ! if (spec%run%is%new)
     112           0 :             call spec%sanitize(err)
     113             : 
     114             :         class default
     115             :             error stop "The input `sampler` must be of type `paradise_type`." ! LCOV_EXCL_LINE
     116             :         end select
     117             : 
     118           0 :     end function
     119             : 
     120             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     121             : 
     122           0 :     subroutine report(spec)
     123             : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
     124             :         !DEC$ ATTRIBUTES DLLEXPORT :: report
     125             : #endif
     126             :         use pm_str, only: UNDEFINED
     127             :         class(specdise_type), intent(inout) :: spec
     128           0 :     end subroutine
     129             : 
     130             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     131             : 
     132           0 :     subroutine sanitize(spec, err)
     133             : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
     134             :         !DEC$ ATTRIBUTES DLLEXPORT :: sanitize
     135             : #endif
     136             :         use pm_err, only: err_type
     137             :         type(err_type), intent(inout) :: err
     138             :         class(specdise_type), intent(inout) :: spec
     139             :         character(*,SKC), parameter :: PROCEDURE_NAME = MODULE_NAME//SKC_"@sanitizeSpecDRAM()"
     140             : 
     141           0 :     end subroutine
     142             : 
     143             :     !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%