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