Simulation Core
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

CProblemDifinition.f90 3.7 KiB

1 year ago
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. module CProblemDifinition
  2. use json_module
  3. use CIActionReference
  4. implicit none
  5. public
  6. integer, parameter :: Time_ProblemType = 0
  7. integer, parameter :: PumpStrokes_ProblemType = 1
  8. integer, parameter :: VolumePumped_ProblemType = 2
  9. integer, parameter :: DistanceDrilled_ProblemType = 3
  10. integer, parameter :: Clear_StatusType = 0
  11. integer, parameter :: Now_StatusType = 1
  12. integer, parameter :: Later_StatusType = 2
  13. integer, parameter :: Executed_StatusType = 3
  14. type, bind(c), public :: CProblem
  15. integer :: ProblemType
  16. integer :: StatusType
  17. real(8) :: Value
  18. real(8) :: DueValue
  19. end type CProblem
  20. contains
  21. subroutine ProblemToJson(parent,name,problem)
  22. type(json_value),pointer :: parent
  23. character(len=*)::name
  24. type(CProblem)::problem
  25. type(json_core) :: json
  26. type(json_value),pointer :: p
  27. ! 1. create new node
  28. call json%create_object(p,name)
  29. ! 2. add member of data type to new node
  30. call json%add(p,"ProblemType",problem%ProblemType)
  31. call json%add(p,"StatusType",problem%StatusType)
  32. call json%add(p,"Value",problem%Value)
  33. call json%add(p,"DueValue",problem%DueValue)
  34. ! 3. add new node to parent
  35. call json%add(parent,p)
  36. end subroutine
  37. subroutine Execute(problem, action)
  38. type(CProblem), intent(inout) :: problem
  39. procedure (ActionInteger), pointer, intent(in) :: action
  40. problem%StatusType = Executed_StatusType
  41. if(problem%StatusType == Executed_StatusType .and. associated(action)) call action(Executed_StatusType)
  42. end subroutine
  43. subroutine ProcessDueTime(problem, action, time)
  44. use CLog3
  45. implicit none
  46. type(CProblem) :: problem
  47. procedure (ActionInteger), pointer, intent(in) :: action
  48. integer :: time
  49. if(problem%ProblemType == Time_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then
  50. if(time >= int(problem%DueValue)) call Execute(problem, action)
  51. end if
  52. end subroutine
  53. subroutine ProcessDuePumpStrokes(problem, action, strokes)
  54. implicit none
  55. type(CProblem) :: problem
  56. procedure (ActionInteger), pointer, intent(in) :: action
  57. integer :: strokes
  58. if(problem%ProblemType == PumpStrokes_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then
  59. if(strokes >= int(problem%DueValue)) call Execute(problem, action)
  60. end if
  61. end subroutine
  62. subroutine ProcessDueVolumePumped(problem, action, volume)
  63. implicit none
  64. type(CProblem) :: problem
  65. procedure (ActionInteger), pointer, intent(in) :: action
  66. real(8) :: volume
  67. if(problem%ProblemType == VolumePumped_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then
  68. if(volume >= problem%DueValue) call Execute(problem, action)
  69. end if
  70. end subroutine
  71. subroutine ProcessDueDistanceDrilled(problem, action, distance)
  72. implicit none
  73. type(CProblem) :: problem
  74. procedure (ActionInteger), pointer, intent(in) :: action
  75. real(8) :: distance
  76. if(problem%ProblemType == DistanceDrilled_ProblemType .and. problem%StatusType /= Executed_StatusType .and. problem%StatusType /= Clear_StatusType) then
  77. if(distance >= problem%DueValue) call Execute(problem, action)
  78. end if
  79. end subroutine
  80. end module CProblemDifinition