SimulationCore2/CSharp/Problems/CProblemDifinition.i90

# 1 "/mnt/c/Projects/VSIM/SimulationCore2/CSharp/Problems/CProblemDifinition.f90"
module CProblemDifinition
    use json_module
    use CIActionReference
	implicit none    
	public
    
    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 ProblemFromJson(parent,name,problem)
        type(json_value),pointer :: parent
        character(len=*)::name
        type(CProblem)::problem
        type(json_core) :: json
        type(json_value),pointer :: p,pval
        
        call json%get(parent,name,p)

! ! 2. add member of data type to new node
		call json%get(p,'ProblemType',pval)
		call json%get(pval,problem%ProblemType)
		call json%get(p,'StatusType',pval)
		call json%get(pval,problem%StatusType)
		call json%get(p,'Value',pval)
		call json%get(pval,problem%Value)
		call json%get(p,'DueValue',pval)
		call json%get(pval,problem%DueValue)
    end subroutine


    subroutine ProblemToJson(parent,name,problem)
        type(json_value),pointer :: parent
        character(len=*)::name
        type(CProblem)::problem
        type(json_core) :: json
        type(json_value),pointer :: p
        
! 1. create new node
        call json%create_object(p,name)
        
! 2. add member of data type to new node
        call json%add(p,"ProblemType",problem%ProblemType)
        call json%add(p,"StatusType",problem%StatusType)
        call json%add(p,"Value",problem%Value)
        call json%add(p,"DueValue",problem%DueValue)
        
! 3. add new node to parent
        call json%add(parent,p)
    end subroutine
    
    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
    
    
    
    subroutine ProcessDueTime(problem, action, time)
        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)
        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)
        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)
        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