module Simulator use Bop use PumpsMain use RopMain use RotaryTableMain use DrawworksMain use FluidFlowMain use TorqueDragMain use MudSystemMain use PipeRams1Main use PipeRams2Main use KillLineMain use ChokeLineMain use BlindRamsMain use AnnularMain use TopDriveMain use CManifolds use GeoMain use ChokeControlMain use COperationScenariosMain ! For Json read and write use CStringConfiguration use CFormation use CReservoir use CShoe use CAccumulator use CBopStack use CHoisting use CPower use CPumpsVariables use CRigSize use CCasingLinerChoke use CPathGeneration use CWellSurveyData ! use CMudProperties use :: json_module, rk => json_rk implicit none real :: a1, a2, a3, a4 real(kind=rk), allocatable :: x0(:) type(json_file) :: jsonfile logical :: is_found real T1,T2 contains subroutine Simulate integer :: t !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! t=0 call write_variables() ! call init_modules() call cpu_time(T1) do while (t<0) !!read variable from shared file call read_variables() exit !! Tarmigh, Now merged with TorqueDrag (FluidFlow) ! call Rop_Step() !! Rafiee, nothing changed call BopStack_Step() !! Tarmigh, now is rewritten call Pump1_Step() !call Pump2_Step() !! Rafiee call ChokeControl_Step() !! Location ./Equipment/Rotarytable !! Variables: !! Does not have step function !! Call RTable_StartUp in the start !! Again has a loop in each step !! Tarmigh, now is rewritten call RotaryTable_Step() !! Location ./Equipment/Drawworks !! Variables: !! Does not have step function !! Call ..._StartUp in the start !! Again has a loop in each step !! Tarmigh, now is rewritten call Drawworks_Step() !! Empty nothing called !! Merged in FluidFlow ! call TorqueDrag_Step() !! Location: ./Equipment/MudSystem !! Variables: MudSystem_variables.f90 and MudSystem.f90 !! Step function simply calls LineupAndPath in MudSystem.f90 !! had not startUp !! Rafiee call MudSystem_Step() !! Location ./Equipment/BopStack !! Variables: VARIABLES,CBopStackVariables,CBopControlPanelVariables,CEquipmentsConstants !! Step function added, only call PIPE_RAMS1 and 2 function !! BOP_StartUp commented !! Rafiee call PipeRams1_Step() call PipeRams2_Step() !! Location ./Equipment/BopStack !! Variables: VARIABLES,CBopStackVariables,CBopControlPanelVariables,CEquipmentsConstants,CAccumulatorVariables,CSimulationVariables !! Step function added, only call PIPE_RAMS1 and PIPE_RAMS2 function !! BOP_StartUp commented !! Rafiee call KillLine_Step() !! Probably like other bopstack equipments !! Rafiee call ChokeLine_Step() call BlindRams_Step() call Annular_Step() !!Tarmigh. Step must rewrittem call TopDrive_Step() !!Empty ! call Geo_Step() !!Ahmadi call PathFinding_Step() !! Sheikh !call FluidFlow_Step() !! Ahmadi call OperationScenarios_Step() !! Write variables to shared files call write_variables() print *,"t=",t t = t + 1 end do call cpu_time(T2) print *,"Total Execution Time =",t2-t1 end subroutine Simulate subroutine write_variables use CAccumulator implicit none type(json_core) :: json type(json_value),pointer :: p print *,"write starts" call json%create_object(p,'') !create the root call ConfigurationToJson(p) call json%print(p,'test.json') !write it to a file call json%destroy(p) !cleanup print *,"written" print *,"write ends" end subroutine subroutine read_variables type(json_core) :: json call jsonfile%initialize() print *,"Starting read" ! ! Load the file. call jsonfile%load_file('config.json'); if (jsonfile%failed()) stop print *,"read complete" call jsonfile%get('t0', a1, is_found); if (.not. is_found) return call jsonfile%get('dt', a2, is_found); if (.not. is_found) return call jsonfile%get('tf', a3, is_found); if (.not. is_found) return call jsonfile%get('mu', a4, is_found); if (.not. is_found) return call jsonfile%get('x0', x0, is_found); if (.not. is_found) return if (is_found) then print *, a1,a2,a3,a4 print *, x0 end if call jsonfile%destroy() end subroutine subroutine init_modules !Tarmigh call Pump1_Init() !call Pump2_Step() call RotaryTable_Init() call Drawworks_Init() call TopDrive_Init() !Nothing in init (and step) ! call Rop_Init() ! call TorqueDrag_Init() ! call Geo_Step() !! Rafiee call BopStack_Init() call ChokeControl_Init() call MudSystem_Init() !Again calls Bop_Startup ! call PipeRams1_Init() ! call PipeRams2_Step() ! call KillLine_Step() ! call ChokeLine_Step() ! call BlindRams_Step() ! call Annular_Step() !! Sheikh !call FluidFlow_Init() !! Ahmadi call PathFinding_Init() ! Calls OSInitialization and that sub only subscribes some notif ! call OperationScenarios_Init() end subroutine init_modules subroutine ConfigurationToJson(parent) type(json_value),pointer :: parent type(json_core) :: json type(json_value),pointer :: p ! 1. create new node call json%create_object(p,'Configuration') ! call AccumulatorToJsonToJson(p) ! 2. add member of data type to new node call StringConfigurationToJson(p) call FormationToJson(p) call ReservoirToJson(p) call ShoeToJson(p) call AccumulatorToJson(p) call BopStackToJson(p) call HoistingToJson(p) call PowerToJson(p) call PumpsToJson(p) call RigSizeToJson(p) call CasingLinerChokeToJson(p) call PathGenerationToJson(p) ! call WellSurveyDataToJson(p) ! call MudPropertiesToJson(p) ! 3. add new node to parent call json%add(parent,p) end subroutine !use this as a template subroutine SomeDSToJson(parent) type(json_value),pointer :: parent type(json_core) :: json type(json_value),pointer :: p ! 1. create new node call json%create_object(p,'Configuration') ! 2. add member of data type to new node ! call StringConfigurationToJson(p) ! call FormationToJson(p) ! call json%add(p,"",data%Configuration%Formation%Formations(i)%Abrasiveness) ! 3. add new node to parent call json%add(parent,p) end subroutine end module Simulator