module CProblemDifinition use CIActionReference implicit none public procedure (ActionInteger), pointer :: Nil => null() integer, parameter :: Time_ProblemType = 0 integer, parameter :: PumpStrokes_ProblemType = 1 integer, parameter :: VolumePumped_ProblemType = 2 integer, parameter :: DistanceDrilled_ProblemType = 3 integer, parameter :: Clear_StatusType = 0 integer, parameter :: Now_StatusType = 1 integer, parameter :: Later_StatusType = 2 integer, parameter :: Executed_StatusType = 3 type, bind(c), public :: CProblem integer :: ProblemType integer :: StatusType real(8) :: Value real(8) :: DueValue end type CProblem contains subroutine Execute(problem, action) type(CProblem), intent(inout) :: problem procedure (ActionInteger), pointer, intent(in) :: action problem%StatusType = Executed_StatusType if(problem%StatusType == Executed_StatusType .and. associated(action)) call action(Executed_StatusType) end subroutine ! type(CProblem) function SetDue(problem, action) ! ! use CSimulationVariables ! implicit none ! type(CProblem), intent(in) :: problem ! procedure (ActionInteger), pointer, intent(in) :: action ! real(8) :: CurrentTime ! real(8) :: CurrentPumpStrokes ! real(8) :: CurrentVolumePumped ! real(8) :: CurrentDistanceDrilled ! real(8) :: Due ! CurrentTime = 0 ! CurrentPumpStrokes = 0 ! CurrentVolumePumped = 0 ! CurrentDistanceDrilled = 0 ! SetDue = problem ! if(problem%StatusType == Clear_StatusType .and. associated(action)) then ! call action(Clear_StatusType) ! SetDue%DueValue = 0 ! return ! endif ! select case (problem%ProblemType) ! case(Time_ProblemType) ! select case (SimulationState) ! case(SimulationState_Stopped) ! CurrentTime = 0 ! case(SimulationState_Started) ! CurrentTime = dble(SimulationTime) ! case(SimulationState_Paused) ! CurrentTime = dble(SimulationTime) ! end select ! Due = problem%Value + CurrentTime ! case(PumpStrokes_ProblemType) ! select case (SimulationState) ! case(SimulationState_Stopped) ! CurrentPumpStrokes = 0 ! case(SimulationState_Started) ! CurrentPumpStrokes = TotalPumpStrokes ! case(SimulationState_Paused) ! CurrentPumpStrokes = TotalPumpStrokes ! end select ! Due = problem%Value + CurrentPumpStrokes ! case(VolumePumped_ProblemType) ! select case (SimulationState) ! case(SimulationState_Stopped) ! CurrentVolumePumped = 0 ! case(SimulationState_Started) ! CurrentVolumePumped = TotalVolumePumped ! case(SimulationState_Paused) ! CurrentVolumePumped = TotalVolumePumped ! end select ! Due = problem%Value + CurrentVolumePumped ! case(DistanceDrilled_ProblemType) ! select case (SimulationState) ! case(SimulationState_Stopped) ! CurrentDistanceDrilled = 0 ! case(SimulationState_Started) ! CurrentDistanceDrilled = DistanceDrilled ! case(SimulationState_Paused) ! CurrentDistanceDrilled = DistanceDrilled ! end select ! Due = problem%Value + CurrentDistanceDrilled ! end select ! SetDue%DueValue = Due ! end function SetDue subroutine ProcessDueTime(problem, action, time) ! use CSimulationVariables use CLog3 implicit none type(CProblem) :: problem procedure (ActionInteger), pointer, intent(in) :: action integer :: time if(problem%ProblemType == Time_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then if(time >= int(problem%DueValue)) call Execute(problem, action) end if end subroutine subroutine ProcessDuePumpStrokes(problem, action, strokes) ! use CSimulationVariables implicit none type(CProblem) :: problem procedure (ActionInteger), pointer, intent(in) :: action integer :: strokes if(problem%ProblemType == PumpStrokes_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then if(strokes >= int(problem%DueValue)) call Execute(problem, action) end if end subroutine subroutine ProcessDueVolumePumped(problem, action, volume) ! use CSimulationVariables implicit none type(CProblem) :: problem procedure (ActionInteger), pointer, intent(in) :: action real(8) :: volume if(problem%ProblemType == VolumePumped_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then if(volume >= problem%DueValue) call Execute(problem, action) end if end subroutine subroutine ProcessDueDistanceDrilled(problem, action, distance) ! use CSimulationVariables implicit none type(CProblem) :: problem procedure (ActionInteger), pointer, intent(in) :: action real(8) :: distance if(problem%ProblemType == DistanceDrilled_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then if(distance >= problem%DueValue) call Execute(problem, action) end if end subroutine end module CProblemDifinition