SimulationCore2/CSharp/Problems/CProblemDifinition.f90

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