The ParaMonte Documentation Website
Current view: top level - kernel - Err_mod.f90 (source / functions) Hit Total Coverage
Test: ParaMonte 1.5.1 :: Coarray Parallel Kernel - Code Coverage Report Lines: 91 94 96.8 %
Date: 2021-01-08 12:59:07 Functions: 5 5 100.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!
       4             : !!!!   MIT License
       5             : !!!!
       6             : !!!!   ParaMonte: plain powerful parallel Monte Carlo library.
       7             : !!!!
       8             : !!!!   Copyright (C) 2012-present, The Computational Data Science Lab
       9             : !!!!
      10             : !!!!   This file is part of the ParaMonte library.
      11             : !!!!
      12             : !!!!   Permission is hereby granted, free of charge, to any person obtaining a
      13             : !!!!   copy of this software and associated documentation files (the "Software"),
      14             : !!!!   to deal in the Software without restriction, including without limitation
      15             : !!!!   the rights to use, copy, modify, merge, publish, distribute, sublicense,
      16             : !!!!   and/or sell copies of the Software, and to permit persons to whom the
      17             : !!!!   Software is furnished to do so, subject to the following conditions:
      18             : !!!!
      19             : !!!!   The above copyright notice and this permission notice shall be
      20             : !!!!   included in all copies or substantial portions of the Software.
      21             : !!!!
      22             : !!!!   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
      23             : !!!!   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
      24             : !!!!   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
      25             : !!!!   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
      26             : !!!!   DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
      27             : !!!!   OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
      28             : !!!!   OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
      29             : !!!!
      30             : !!!!   ACKNOWLEDGMENT
      31             : !!!!
      32             : !!!!   ParaMonte is an honor-ware and its currency is acknowledgment and citations.
      33             : !!!!   As per the ParaMonte library license agreement terms, if you use any parts of
      34             : !!!!   this library for any purposes, kindly acknowledge the use of ParaMonte in your
      35             : !!!!   work (education/research/industry/development/...) by citing the ParaMonte
      36             : !!!!   library as described on this page:
      37             : !!!!
      38             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
      39             : !!!!
      40             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      41             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      42             : 
      43             : !>  \brief This module contains classes and procedures for reporting and handling errors.
      44             : !>  \author Amir Shahmoradi
      45             : 
      46             : module Err_mod
      47             : 
      48             :     character(*), parameter :: MODULE_NAME = "@Err_mod"
      49             : 
      50             :     logical     , parameter :: ERR_HANDLING_REQUESTED = .false.
      51             : 
      52             : #if defined CODECOV_ENABLED || defined BASIC_TEST_ENABLED || defined SAMPLER_TEST_ENABLED || ((defined MATLAB_ENABLED || defined PYTHON_ENABLED || defined R_ENABLED) && !defined CAF_ENABLED && !defined MPI_ENABLED)
      53             :     logical     , parameter :: SOFT_EXIT_ENABLED = .true.
      54             : #else
      55             :     logical     , parameter :: SOFT_EXIT_ENABLED = .false.
      56             : #endif
      57             : 
      58             :     !> The error type.
      59             :     type :: Err_type
      60             :         logical                     :: occurred = .false.
      61             :         integer                     :: stat     = -huge(0)          !< The output integer flag or status code by the compiler or program.
      62             :         integer                     :: statNull = -huge(0)          !< The null value initially assigned to `stat`.
      63             :         character(:), allocatable   :: msg                          !< The error message.
      64             :     end type Err_type
      65             : 
      66             :     logical :: mv_isTestingMode = .false.   !< A logical flag, only to be used and set for testing purposes.
      67             : 
      68             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      69             : 
      70             : contains
      71             : 
      72             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      73             : 
      74             :     !> Terminate or report the occurrence a fatal error and potentially terminate the program (if requested).
      75             :     !> @param[in]   Err             :   An object of type [Err_type](@ref err_type) containing the error information.
      76             :     !> @param[in]   prefix          :   The string to prepend to the error message (**optional**, default = dynamically set).
      77             :     !> @param[in]   newline         :   The substring representing the newline character in the error message (**optional**, default = "\n").
      78             :     !> @param[in]   outputUnit      :   The output file unit (**optional**, default = stdout).
      79             :     !> @param[in]   returnEnabled   :   A logical value. If `.true.`, the program will not be abruptly terminated.
      80             :     !>                                  Instead, the control is returned to the calling routine.
      81         384 :     subroutine abort(Err, prefix, newline, outputUnit, returnEnabled)
      82             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
      83             :         !DEC$ ATTRIBUTES DLLEXPORT :: abort
      84             : #endif
      85             :         use, intrinsic :: iso_fortran_env, only: output_unit
      86             :         use Decoration_mod, only: write
      87             :         use Constants_mod, only: NLC
      88             :         implicit none
      89             :         type(Err_type)  , intent(in), optional  :: Err
      90             :         character(*)    , intent(in), optional  :: prefix, newline
      91             :         integer         , intent(in), optional  :: outputUnit
      92             :         logical         , intent(in), optional  :: returnEnabled
      93             : 
      94             :         logical                                 :: returnEnabledDefault
      95         384 :         character(:), allocatable               :: pfx, msg, nlstr
      96             :         character(63)                           :: dummyChar1, imageChar !, dummyChar2
      97             : 
      98         384 :         if (present(returnEnabled)) then
      99           3 :             returnEnabledDefault = returnEnabled
     100             :         else
     101         381 :             returnEnabledDefault = SOFT_EXIT_ENABLED
     102             :         end if
     103             : 
     104         384 :         if (present(Err)) then
     105             : 
     106             : #if defined CAF_ENABLED
     107         384 :             write(imageChar ,"(g0)") this_image()
     108             : #elif defined MPI_ENABLED
     109             :             block
     110             :                 use mpi
     111             :                 integer :: imageID, ierrMPI
     112             :                 call mpi_comm_rank(mpi_comm_world, imageID, ierrMPI)
     113             :                 write(imageChar ,"(g0)") imageID + 1
     114             :             end block
     115             : #else
     116             :             imageChar =  "1"
     117             : #endif
     118             : 
     119         384 :             if (present(newline)) then
     120         381 :                 nlstr = newline
     121             :             else
     122           3 :                 nlstr = NLC
     123             :             end if
     124             : 
     125         384 :             if (Err%stat==Err%statNull) then    ! it is a null error code, ignore it and do not report the error code
     126          15 :                 msg = Err%msg
     127             :             else
     128         369 :                 write(dummyChar1,"(g0)") Err%stat
     129             :                !write(dummyChar2,"(g0)") Err%statNull
     130             :                !msg =   Err%msg // nlstr // "Error Code: " // trim(adjustl(dummyChar1)) // ". Null Error Code: " // trim(adjustl(dummyChar2)) // "."
     131         369 :                 msg =   Err%msg // nlstr // "Error Code: " // trim(adjustl(dummyChar1)) // "."
     132             :             end if
     133             : 
     134         387 :             if (present(prefix)) then
     135         381 :                 call informUser(msg,prefix//" - FATAL: ",nlstr,outputUnit)
     136         381 :                 pfx = prefix
     137             :             else
     138           3 :                 call informUser(msg," - FATAL: ",nlstr,outputUnit)
     139           3 :                 pfx = ""
     140             :             end if
     141             : 
     142         384 :             if (present(outputUnit)) then
     143         384 :                 if (outputUnit/=output_unit) then
     144         136 :                     call write(outputUnit,1,0,1, pfx // " - Please correct the error(s) and rerun the program." )
     145         136 :                     call write(outputUnit,0,0,1, pfx // " - If the cause of the error cannot be diagnosed, please report it at:" )
     146         136 :                     call write(outputUnit,0,0,1, pfx // " -" )
     147         136 :                     call write(outputUnit,0,0,1, pfx // " -     https://github.com/cdslaborg/paramonte/issues" )
     148         136 :                     call write(outputUnit,0,0,1, pfx // " -" )
     149         136 :                     call write(outputUnit,0,2,1, pfx // " - Gracefully exiting on image " // trim(adjustl(imageChar)) // "." )
     150             :                 end if
     151             :             end if
     152             : 
     153             :             ! notify the user on screen too
     154             : 
     155         384 :             if (.not. mv_isTestingMode) then
     156             :             ! LCOV_EXCL_START
     157             :                 call write(output_unit,1,0,1, pfx // " - FATAL: Runtime error occurred." )
     158             :                 call write(output_unit,0,0,1, pfx // " - FATAL: For more information, see the output '*_report.txt' file (if generated)." )
     159             :                 call write(output_unit,0,2,1, pfx // " - FATAL: Gracefully exiting on image " // trim(adjustl(imageChar)) // "." )
     160             :             end if
     161             :             ! LCOV_EXCL_STOP
     162             : 
     163         384 :             flush(output_unit) ! call execute_command_line(" ")
     164         384 :             flush(outputUnit)
     165             : 
     166             :             ! wait for one second:
     167             :             block
     168             :                 use Constants_mod, only: RK
     169             :                 use, intrinsic  :: iso_fortran_env, only: int64
     170             :                 integer(int64)  :: countOld, countNew, countMax
     171         384 :                 real(RK)        :: countRate
     172         384 :                 call system_clock( count=countOld, count_rate=countRate, count_max=countMax )
     173         384 :                 if (countOld/=-huge(0_int64) .and. countRate/=0._RK .and. countMax==0_int64) then
     174             :                 ! LCOV_EXCL_START
     175             :                     loopWait: do
     176             :                         call system_clock( count=countNew )
     177             :                         if (countNew==countMax) then
     178             :                             if (returnEnabledDefault) return
     179             :                             error stop
     180             :                         elseif ( real(countNew-countOld,kind=RK) / countRate >= 2._RK ) then
     181             :                             exit loopWait
     182             :                         end if
     183             :                         cycle
     184             :                     end do loopWait
     185             :                 end if
     186             :                 ! LCOV_EXCL_STOP
     187             :             end block
     188             : 
     189             :         end if
     190             : 
     191         384 :         if (returnEnabledDefault .or. mv_isTestingMode) return
     192             : 
     193             : ! LCOV_EXCL_START
     194             : #if defined MPI_ENABLED
     195             :         block
     196             :             use mpi
     197             :             integer :: ierrMPI, errcode
     198             :             errcode = 1; call mpi_abort(mpi_comm_world, errcode, ierrMPI)
     199             :         end block
     200             : #else
     201             :         error stop
     202             : #endif
     203             : ! LCOV_EXCL_STOP
     204             : 
     205         384 :     end subroutine abort
     206             : 
     207             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     208             : 
     209             :     !> Report warning message.
     210             :     !> @param[in]   msg         : The warning message.
     211             :     !> @param[in]   prefix      : The string to prepend to the error message (**optional**, default = dynamically set).
     212             :     !> @param[in]   newline     : The substring representing the newline character in the error message (**optional**, default = "\n").
     213             :     !> @param[in]   outputUnit  : The output file unit (**optional**, default = stdout).
     214             :     !> @param[in]   marginTop   : The number of empty lines before printing the message to the output (**optional**).
     215             :     !> @param[in]   marginBot   : The number of empty lines after printing the message to the output (**optional**).
     216         803 :     subroutine warn(msg,prefix,newline,outputUnit,marginTop,marginBot)
     217             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     218             :         !DEC$ ATTRIBUTES DLLEXPORT :: warn
     219             : #endif
     220         384 :         use Constants_mod, only: IK
     221             :         implicit none
     222             :         character(*), intent(in)            :: msg
     223             :         character(*), intent(in), optional  :: prefix, newline
     224             :         integer(IK) , intent(in), optional  :: outputUnit,marginTop,marginBot
     225         803 :         if (present(prefix)) then
     226             :             call informUser ( msg           = msg                       &
     227             :                             , prefix        = prefix // " - WARNING: "  &
     228             :                             , newline       = newline                   &
     229             :                             , outputUnit    = outputUnit                &
     230             :                             , marginTop     = marginTop                 &
     231             :                             , marginBot     = marginBot                 &
     232         800 :                             )
     233             :         else
     234             :             call informUser ( msg           = msg                       &
     235             :                             , prefix        = " - WARNING: "            &
     236             :                             , newline       = newline                   &
     237             :                             , outputUnit    = outputUnit                &
     238             :                             , marginTop     = marginTop                 &
     239             :                             , marginBot     = marginBot                 &
     240           3 :                             )
     241             :         end if
     242        1606 :     end subroutine warn
     243             : 
     244             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     245             : 
     246             :     !> Report a note.
     247             :     !> @param[in]   msg         : The warning message.
     248             :     !> @param[in]   prefix      : The string to prepend to the error message (**optional**, default = dynamically set).
     249             :     !> @param[in]   newline     : The substring representing the newline character in the error message (**optional**, default = "\n").
     250             :     !> @param[in]   outputUnit  : The output file unit (**optional**, default = stdout).
     251             :     !> @param[in]   marginTop   : The number of empty lines before printing the message to the output (**optional**).
     252             :     !> @param[in]   marginBot   : The number of empty lines after printing the message to the output (**optional**).
     253       34203 :     subroutine note(msg,prefix,newline,outputUnit,marginTop,marginBot)
     254             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     255             :         !DEC$ ATTRIBUTES DLLEXPORT :: note
     256             : #endif
     257         803 :         use Constants_mod, only: IK
     258             :         implicit none
     259             :         character(*), intent(in)            :: msg
     260             :         character(*), intent(in), optional  :: prefix, newline
     261             :         integer(IK) , intent(in), optional  :: outputUnit,marginTop,marginBot
     262       34203 :         if (present(prefix)) then
     263             :             call informUser ( msg           = msg                   &
     264             :                             , prefix        = prefix // " - NOTE: " &
     265             :                             , newline       = newline               &
     266             :                             , outputUnit    = outputUnit            &
     267             :                             , marginTop     = marginTop             &
     268             :                             , marginBot     = marginBot             &
     269       34200 :                             )
     270             :         else
     271             :             call informUser ( msg           = msg                   &
     272             :                             , prefix        = " - NOTE: "           &
     273             :                             , newline       = newline               &
     274             :                             , outputUnit    = outputUnit            &
     275             :                             , marginTop     = marginTop             &
     276             :                             , marginBot     = marginBot             &
     277           3 :                             )
     278             :         end if
     279       68406 :     end subroutine note
     280             : 
     281             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     282             : 
     283             :     !> Write the input message to the output file unit.
     284             :     !> @param[in]   msg         : The warning message.
     285             :     !> @param[in]   prefix      : The string to prepend to the error message (**optional**, default = dynamically set).
     286             :     !> @param[in]   newline     : The substring representing the newline character in the error message (**optional**, default = "\n").
     287             :     !> @param[in]   outputUnit  : The output file unit (**optional**, default = stdout).
     288             :     !> @param[in]   wrapSplit   : The substring at which the input `msg` can be wrapped and continued on the next line (**optional**, default = " ").
     289             :     !> @param[in]   wrapWidth   : The maximum width of the line beyond which the input `msg` is wrapped and continued on the next line (**optional**, default = 100).
     290             :     !> @param[in]   marginTop   : The number of empty lines before printing the message to the output (**optional**).
     291             :     !> @param[in]   marginBot   : The number of empty lines after printing the message to the output (**optional**).
     292       35749 :     subroutine informUser(msg,prefix,newline,outputUnit,wrapSplit,wrapWidth,marginTop,marginBot)
     293             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     294             :         !DEC$ ATTRIBUTES DLLEXPORT :: informUser
     295             : #endif
     296             :         use, intrinsic :: iso_fortran_env, only: output_unit
     297       34203 :         use Decoration_mod, only: write, getListOfLines, wrapText
     298             :         use JaggedArray_mod, only: CharVec_type
     299             :         use Constants_mod, only: IK
     300             :         implicit none
     301             :         character(*), intent(in)            :: msg
     302             :         character(*), intent(in), optional  :: prefix, newline, wrapSplit
     303             :         integer(IK) , intent(in), optional  :: outputUnit, wrapWidth, marginTop, marginBot
     304             : 
     305             :         integer(IK)                         :: stdout, sizeList, sizeListJustified
     306             :         integer(IK)                         :: irecord, ijustified, width
     307             :         integer(IK)                         :: padTop, padBot, padTopCurrent, padBotCurrent
     308       35749 :         character(:), allocatable           :: pfx, split
     309       35749 :         type(CharVec_type), allocatable     :: List(:), ListJustified(:)
     310             : 
     311       35749 :         if (present(outputUnit)) then
     312       35749 :             stdout = outputUnit
     313             :         ! LCOV_EXCL_START
     314             :         else
     315             :             stdout = output_unit
     316             :         end if
     317             :         ! LCOV_EXCL_STOP
     318       35749 :         if (present(prefix)) then
     319       35749 :             pfx = prefix
     320             :         else
     321           0 :             pfx = ""
     322             :         end if
     323       35749 :         if (present(wrapSplit)) then
     324           0 :             split = wrapSplit
     325             :         else
     326       35749 :             split = " "
     327             :         end if
     328       35749 :         if (present(wrapWidth)) then
     329         359 :             width = wrapWidth
     330             :         else
     331       35390 :             width = 100_IK
     332             :         end if
     333       35749 :         if (present(marginTop)) then
     334       15154 :             padTop = marginTop
     335             :         else
     336       20595 :             padTop = 1_IK
     337             :         end if
     338       35749 :         if (present(marginBot)) then
     339       15272 :             padBot = marginBot
     340             :         else
     341       20477 :             padBot = 1_IK
     342             :         end if
     343             : 
     344      330704 :         List = getListOfLines(string=msg,delimiter=newline)
     345       35749 :         sizeList = size(List)
     346      165352 :         do irecord = 1, sizeList
     347           0 :             ListJustified = wrapText( string    = List(irecord)%record  &
     348             :                                     , width     = width                 &
     349             :                                     , split     = split                 &
     350             :                                     , pad       = " "                   &
     351      900648 :                                     )
     352      129603 :             sizeListJustified = size(ListJustified)
     353      445028 :             do ijustified = 1, sizeListJustified
     354      279676 :                 padTopCurrent = 0_IK
     355      279676 :                 padBotCurrent = 0_IK
     356      279676 :                 if (irecord==1 .and. ijustified==1_IK) padTopCurrent = padTop ! the very first line
     357      279676 :                 if (irecord==sizeList .and. ijustified==sizeListJustified) padBotCurrent = padBot ! the very last line
     358      409279 :                 call write(stdout, padTopCurrent, padBotCurrent, 1_IK, pfx // ListJustified(ijustified)%record )
     359             :             end do
     360             :         end do
     361       35749 :         if (.not.present(marginBot)) call write(stdout)
     362             : 
     363      287748 :     end subroutine informUser
     364             : 
     365             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     366             : 
     367             : #if (defined MPI_ENABLED || defined CAF_ENABLED) && (defined CODECOV_ENABLED || defined SAMPLER_TEST_ENABLED)
     368             :     !> \brief
     369             :     !> Broadcast the error condition from all images to all images. 
     370             :     !> 
     371             :     !> \param[in]   Err : An object of type [Err_type](@ref err_type) containing the error information.
     372             :     !> 
     373             :     !> \warning
     374             :     !> This subroutine must be called in parallel by ALL images or NONE.
     375             :     !> 
     376             :     !> \warning
     377             :     !> This function solely exist for soft handling of fatal errors in parallel testing mode and 
     378             :     !> should therefore must never be defined and used in production builds. This function is defined 
     379             :     !> by either `CODECOV_ENABLED` or `SAMPLER_TEST_ENABLED` preprocessor flags in parallel builds and if 
     380             :     !> defined, it will SIGNIFICANTLY degrade the parallel performance of the code. 
     381             :     !> Therefore, **`SAMPLER_TEST_ENABLED` should never be defined when building for production**.
     382        7338 :     subroutine bcastErr(Err)
     383             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     384             :         !DEC$ ATTRIBUTES DLLEXPORT :: bcastErr
     385             : #endif
     386       35749 :         use Constants_mod, only: IK
     387             :         implicit none
     388             :         type(Err_type), intent(inout)   :: Err
     389             :         integer                         :: imageID, imageCount
     390             : #if defined CAF_ENABLED
     391             :         block
     392             :             logical, allocatable, save  :: ErrorOccurred(:)[:]
     393             :             integer(IK)                 :: i
     394        7338 :             imageID     = this_image()
     395        7338 :             imageCount  = num_images()
     396        7338 :             allocate(ErrorOccurred(imageCount)[*])
     397        7338 :             ErrorOccurred(imageID) = Err%occurred
     398        7338 :             sync all
     399       29352 :             do i = 1, imageCount
     400       29352 :                 ErrorOccurred(i) = ErrorOccurred(i)[i]
     401             :             end do
     402       28236 :             Err%occurred = any(ErrorOccurred)
     403        7338 :             deallocate(ErrorOccurred)
     404             :         end block
     405             : #elif defined MPI_ENABLED
     406             :         block
     407             :             use mpi
     408             :             integer                     :: ierrMPI
     409             :             logical, allocatable        :: ErrorOccurred(:)
     410             :             call mpi_comm_rank(mpi_comm_world, imageID, ierrMPI)
     411             :             call mpi_comm_size(mpi_comm_world, imageCount, ierrMPI)
     412             :             allocate(ErrorOccurred(imageCount))
     413             :             call mpi_allgather  ( Err%occurred      &   ! LCOV_EXCL_LINE : send buffer
     414             :                                 , 1                 &   ! LCOV_EXCL_LINE : send count
     415             :                                 , mpi_logical       &   ! LCOV_EXCL_LINE : send datatype
     416             :                                 , ErrorOccurred(:)  &   ! LCOV_EXCL_LINE : receive buffer
     417             :                                 , 1                 &   ! LCOV_EXCL_LINE : receive count
     418             :                                 , mpi_logical       &   ! LCOV_EXCL_LINE : receive datatype
     419             :                                 , mpi_comm_world    &   ! LCOV_EXCL_LINE : comm
     420             :                                 , ierrMPI           &   ! LCOV_EXCL_LINE : ierr
     421             :                                 )
     422             :            !call mpi_alltoall   ( Err%occurred &    ! buffer_send   : The buffer containing the data that will be scattered to other processes.
     423             :            !                    , 1 &               ! count_send    : The number of elements that will be sent to each process.
     424             :            !                    , mpi_logical &     ! datatype_send : The type of one send buffer element.
     425             :            !                    , ErrorOccurred &   ! buffer_recv   : The buffer in which store the gathered data.
     426             :            !                    , imageCount &      ! count_recv    : The number of elements in the message to receive per process, not the total number of elements to receive from all processes altogether.
     427             :            !                    , mpi_logical &     ! datatype_recv : The type of one receive buffer element.
     428             :            !                    , mpi_comm_world &  ! communicator  : The communicator in which the all to all takes place.
     429             :            !                    , ierrMPI &         ! ierror        : The error code returned from the all to all.
     430             :            !                    )
     431             :             Err%occurred = any(ErrorOccurred)
     432             :             deallocate(ErrorOccurred)
     433             :         end block
     434             : #endif
     435        7338 :     end subroutine bcastErr
     436             : #endif
     437             : 
     438             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     439             : 
     440             : end module Err_mod ! LCOV_EXCL_LINE

ParaMonte: Plain Powerful Parallel Monte Carlo Library 
The Computational Data Science Lab
© Copyright 2012 - 2021