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