|
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798 |
- 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 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
|