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