SimulationCore2/CSharp/ErrorLog/CError.f90

module CError
    use CIActionReference
    implicit none    
    public    
        interface Error
            module procedure :: Error1, Error2, Error3, Error4, Error5
        end interface
        
        interface ErrorStop
            module procedure :: ErrorStop1, ErrorStop2, ErrorStop3, ErrorStop4, ErrorStop5
        end interface
        
        procedure (ActionString), pointer :: ErrorMessagePtr
        procedure (ActionStringInt), pointer :: ErrorMessageIntPtr
        procedure (ActionStringFloat), pointer :: ErrorMessageFloatPtr
        procedure (ActionStringDouble), pointer :: ErrorMessageDoublePtr
        procedure (ActionStringBool), pointer :: ErrorMessageBoolPtr
        
        procedure (ActionString), pointer :: ErrorStopPtr
        procedure (ActionStringInt), pointer :: ErrorStopIntPtr
        procedure (ActionStringFloat), pointer :: ErrorStopFloatPtr
        procedure (ActionStringDouble), pointer :: ErrorStopDoublePtr
        procedure (ActionStringBool), pointer :: ErrorStopBoolPtr
    contains 
    
    subroutine Error1(message)
        implicit none
        character(len=*), intent(in) :: message
        if(associated(ErrorMessagePtr)) call ErrorMessagePtr(message)
    end subroutine
    
    subroutine Error2(message, value)
        implicit none
        character(len=*), intent(in) :: message
        integer, intent(in) :: value
        !character(len=256) :: temp
        !temp(:)=' '
        !write(temp,*) value
        !if(associated(ErrorMessagePtr)) call ErrorMessagePtr(trim(message//' '//adjustl(temp)))
        if(associated(ErrorMessageIntPtr)) call ErrorMessageIntPtr(message, value)
    end subroutine
    
    subroutine Error3(message, value)
        implicit none
        character(len=*), intent(in) :: message
        real, intent(in) :: value
        !character(len=256) :: temp
        !temp(:)=' '
        !write(temp,*) value
        !if(associated(ErrorMessagePtr)) call ErrorMessagePtr(trim(message//' '//adjustl(temp)))
        if(associated(ErrorMessageFloatPtr)) call ErrorMessageFloatPtr(message, value)
    end subroutine
    
    subroutine Error4(message, value)
        implicit none
        character(len=*), intent(in) :: message
        real(8), intent(in) :: value
        !character(len=256) :: temp
        !temp(:)=' '
        !write(temp,*) value
        !if(associated(ErrorMessagePtr)) call ErrorMessagePtr(trim(message//' '//adjustl(temp)))
        if(associated(ErrorMessageDoublePtr)) call ErrorMessageDoublePtr(message, value)
    end subroutine
    
    subroutine Error5(message, value)
        implicit none
        character(len=*), intent(in) :: message
        logical, intent(in) :: value
        !if(value) then
        !    if(associated(ErrorMessagePtr)) call ErrorMessagePtr(message//' '//'TRUE')
        !else
        !    if(associated(ErrorMessagePtr)) call ErrorMessagePtr(message//' '//'FALSE')
        !endif
        if(associated(ErrorMessageBoolPtr)) call ErrorMessageBoolPtr(message, value)
    end subroutine
    
    
    
    
    
    
    
    
    
    
    
    
    
    subroutine ErrorStop1(message)
        !use ifmt
        implicit none
        character(len=*), intent(in) :: message
        if(associated(ErrorStopPtr)) then 
            call ErrorStopPtr(message) 
            ! call ExitThread(0)         
        end if
    end subroutine
    
    subroutine ErrorStop2(message, value)
        !use ifmt
        implicit none
        character(len=*), intent(in) :: message
        integer, intent(in) :: value
        !character(len=256) :: temp
        !temp(:)=' '
        !write(temp,*) value
        !if(associated(ErrorStopPtr)) then 
        !    call ErrorStopPtr(trim(message//' '//adjustl(temp))) 
        !    ! call ExitThread(0)         
        !end if
        if(associated(ErrorStopIntPtr)) then 
            call ErrorStopIntPtr(message, value) 
            ! call ExitThread(0)         
        end if
    end subroutine
        
    subroutine ErrorStop3(message, value)
        !use ifmt
        implicit none
        character(len=*), intent(in) :: message
        real, intent(in) :: value
        !character(len=256) :: temp
        !temp(:)=' '
        !write(temp,*) value
        !if(associated(ErrorStopPtr)) then 
        !    call ErrorStopPtr(trim(message//' '//adjustl(temp))) 
        !    ! call ExitThread(0)         
        !end if
        if(associated(ErrorStopFloatPtr)) then 
            call ErrorStopFloatPtr(message, value) 
            ! ! call ExitThread(0)         
        end if
    end subroutine
    
    subroutine ErrorStop4(message, value)
        ! use ifmt
        implicit none
        character(len=*), intent(in) :: message
        real(8), intent(in) :: value
        !character(len=256) :: temp
        !temp(:)=' '
        !write(temp,*) value
        !if(associated(ErrorStopPtr)) then 
        !    call ErrorStopPtr(trim(message//' '//adjustl(temp))) 
        !    ! call ExitThread(0)         
        !end if
        if(associated(ErrorStopDoublePtr)) then 
            call ErrorStopDoublePtr(message, value) 
            ! ! call ExitThread(0)         
        end if
    end subroutine
    
    subroutine ErrorStop5(message, value)
        !use ifmt
        implicit none
        character(len=*), intent(in) :: message
        logical, intent(in) :: value
        !if(value) then
        !    if(associated(ErrorStopPtr)) then 
        !        call ErrorStopPtr(message//' '//'TRUE') 
        !        ! ! call ExitThread(0)         
        !    end if
        !else
        !    if(associated(ErrorStopPtr)) then 
        !        call ErrorStopPtr(message//' '//'FALSE') 
        !        ! ! call ExitThread(0)         
        !    end if
        !endif
        if(associated(ErrorStopBoolPtr)) then 
            call ErrorStopBoolPtr(message, value) 
            ! call ExitThread(0)         
        end if
    end subroutine
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    subroutine SubscribeErrorMessage(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessage
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessage' :: SubscribeErrorMessage
        implicit none
        procedure (ActionString) :: a
        ErrorMessagePtr => a
    end subroutine
    
    
    subroutine SubscribeErrorMessageInt(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageInt
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageInt' :: SubscribeErrorMessageInt
        implicit none
        procedure (ActionStringInt) :: a
        ErrorMessageIntPtr => a
    end subroutine
    
    subroutine SubscribeErrorMessageFloat(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageFloat
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageFloat' :: SubscribeErrorMessageFloat
        implicit none
        procedure (ActionStringFloat) :: a
        ErrorMessageFloatPtr => a
    end subroutine
    
    subroutine SubscribeErrorMessageDouble(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageDouble
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageDouble' :: SubscribeErrorMessageDouble
        implicit none
        procedure (ActionStringDouble) :: a
        ErrorMessageDoublePtr => a
    end subroutine
    
    subroutine SubscribeErrorMessageBool(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorMessageBool
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorMessageBool' :: SubscribeErrorMessageBool
        implicit none
        procedure (ActionStringBool) :: a
        ErrorMessageBoolPtr => a
    end subroutine
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    subroutine SubscribeErrorStop(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStop
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStop' :: SubscribeErrorStop
        implicit none
        procedure (ActionString) :: a
        ErrorStopPtr => a
    end subroutine
    
    subroutine SubscribeErrorStopInt(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopInt
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopInt' :: SubscribeErrorStopInt
        implicit none
        procedure (ActionStringInt) :: a
        ErrorStopIntPtr => a
    end subroutine
    
    
    subroutine SubscribeErrorStopFloat(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopFloat
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopFloat' :: SubscribeErrorStopFloat
        implicit none
        procedure (ActionStringFloat) :: a
        ErrorStopFloatPtr => a
    end subroutine
    
    subroutine SubscribeErrorStopDouble(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopDouble
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopDouble' :: SubscribeErrorStopDouble
        implicit none
        procedure (ActionStringDouble) :: a
        ErrorStopDoublePtr => a
    end subroutine
    
    subroutine SubscribeErrorStopBool(a) 
    !DEC$ ATTRIBUTES DLLEXPORT :: SubscribeErrorStopBool
    !DEC$ ATTRIBUTES ALIAS: 'SubscribeErrorStopBool' :: SubscribeErrorStopBool
        implicit none
        procedure (ActionStringBool) :: a
        ErrorStopBoolPtr => a
    end subroutine
    
end module CError