module Simulator use RedisInterface 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 MudPropertiesModule use CBitProblems use CBopProblems use CChokeProblems use CDrillStemProblems use CGaugesProblems use CHoistingProblems use CKickProblems use CLostProblems use CMudTreatmentProblems use COtherProblems use CPumpProblems use CRotaryProblems use OperationScenariosModule use PermissionsModule use UnitySignalsModule use :: json_module, rk => json_rk implicit none type(json_file) :: jsonfile type(json_value),pointer :: jsonvalue type(json_core) :: jsoncore logical :: is_found real T1,T2 character(len=:),allocatable::redisContent contains subroutine Simulate integer :: t !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! t=0 ! call initConnection() ! print *,"redis exmaple program" ! call jsoncore%create_object(jsonvalue,'') ! call ConfigurationToJson(jsonvalue) ! call WarningsToJson(jsonvalue) ! call ProblemsToJson(jsonvalue) ! print *,"write starts" ! call jsoncore%serialize(jsonvalue,redisContent) ! ! s = "Test redis write!" ! call setData(redisContent) ! print *,"write ends len=",len(redisContent) ! call getData(s2) ! print *,"len(read)=",len(s2) ! print *, s2(1:10),' .... ', s2(len(s2)-10:len(s2)) ! call deallocateData() ! ! print *,"S2 = ",s2 ! deallocate(s2) call jsoncore%create_object(jsonvalue,'') call initConnection() call write_variables() call read_variables() ! print *,"s2=",redisContent ! call deallocateData() ! print *,"redisContent Deallocated!" ! print *,"s2=",redisContent ! 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 jsoncore%destroy(jsonvalue) ! call cpu_time(T2) ! print *,"Total Execution Time =",t2-t1 end subroutine Simulate subroutine write_variables() use CAccumulator use json_module implicit none ! character(len=:),allocatable::s call ConfigurationToJson(jsonvalue) call WarningsToJson(jsonvalue) call ProblemsToJson(jsonvalue) print *,"write starts" <<<<<<< HEAD call jsoncore%serialize(jsonvalue,redisContent) ! s = "Test redis write!" call setData(redisContent) ======= 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" >>>>>>> 12c8e5ea51ec0ab746d971224588f794381f80d2 print *,"write ends" end subroutine subroutine read_variables call getData(redisContent) call jsoncore%deserialize(jsonvalue,redisContent) ! print *,"Read from Redix:",redisContent ! ! 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') ! 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 subroutine WarningsToJson(parent) type(json_value),pointer :: parent type(json_core) :: json type(json_value),pointer :: p ! 1. create new node call json%create_object(p,'Warnings') ! 2. add member of data type to new node call json%add(p,"PumpWithKellyDisconnected",data%Warnings%PumpWithKellyDisconnected) call json%add(p,"PumpWithTopdriveDisconnected",data%Warnings%PumpWithTopdriveDisconnected) call json%add(p,"Pump1PopOffValveBlown",data%Warnings%Pump1PopOffValveBlown) call json%add(p,"Pump1Failure",data%Warnings%Pump1Failure) call json%add(p,"Pump2PopOffValveBlown",data%Warnings%Pump2PopOffValveBlown) call json%add(p,"Pump2Failure",data%Warnings%Pump2Failure) call json%add(p,"Pump3PopOffValveBlown",data%Warnings%Pump3PopOffValveBlown) call json%add(p,"Pump3Failure",data%Warnings%Pump3Failure) call json%add(p,"DrawworksGearsAbuse",data%Warnings%DrawworksGearsAbuse) call json%add(p,"RotaryGearsAbuse",data%Warnings%RotaryGearsAbuse) call json%add(p,"HoistLineBreak",data%Warnings%HoistLineBreak) call json%add(p,"PartedDrillString",data%Warnings%PartedDrillString) call json%add(p,"ActiveTankOverflow",data%Warnings%ActiveTankOverflow) call json%add(p,"ActiveTankUnderVolume",data%Warnings%ActiveTankUnderVolume) call json%add(p,"TripTankOverflow",data%Warnings%TripTankOverflow) call json%add(p,"DrillPipeTwistOff",data%Warnings%DrillPipeTwistOff) call json%add(p,"DrillPipeParted",data%Warnings%DrillPipeParted) call json%add(p,"TripWithSlipsSet",data%Warnings%TripWithSlipsSet) call json%add(p,"Blowout",data%Warnings%Blowout) call json%add(p,"UndergroundBlowout",data%Warnings%UndergroundBlowout) call json%add(p,"MaximumWellDepthExceeded",data%Warnings%MaximumWellDepthExceeded) call json%add(p,"CrownCollision",data%Warnings%CrownCollision) call json%add(p,"FloorCollision",data%Warnings%FloorCollision) call json%add(p,"TopdriveRotaryTableConfilict",data%Warnings%TopdriveRotaryTableConfilict) ! 3. add new node to parent call json%add(parent,p) end subroutine subroutine ProblemsToJson(parent) type(json_value),pointer :: parent type(json_core) :: json type(json_value),pointer :: p ! 1. create new node call json%create_object(p,'Problems') ! 2. add member of data type to new node call BitProblemsToJson(p) call BopProblemsToJson(p) call ChokeProblemsToJson(p) call DrillStemProblemsToJson(p) call GaugesProblemsToJson(p) call HoistingProblemsToJson(p) call KickProblemsToJson(p) call LostProblemsToJson(p) call MudTreatmentProblemsToJson(p) call OtherProblemsToJson(p) call PumpProblemsToJson(p) call RotaryProblemsToJson(p) ! 3. add new node to parent call json%add(parent,p) end subroutine subroutine StateToJson(parent) type(json_value),pointer :: parent type(json_core) :: json type(json_value),pointer :: p ! 1. create new node call json%create_object(p,'State') ! call OperationScenarioToJson(p) call notificationsToJson(p) ! call permissionsToJson(p) ! call unitySignalsToJson(p) ! call StudentStationToJson(p) ! call BopStackInputToJson(p) ! call BopStackAccToJson(p) ! call RamLineToJson(p) ! call AnnularComputationalToJson(p) ! call AnnularToJson(p) ! call PipeRam1ToJson(p) ! call ShearRamToJson(p) ! call PipeRam2ToJson(p) ! call ChokeLineToJson(p) ! call KillLineToJson(p) ! call PumpsToJson(p) ! call RAMToJson(p) ! call RAMSToJson(p) ! call ChokeToJson(p) ! call AirDrivenPumpToJson(p) ! call AirPumpLineToJson(p) ! call CHOOKEToJson(p) ! call DrawworksToJson(p) ! call MudSystemToJson(p) ! call MUDToJson(p) ! call MPumpsToJson(p) ! call PUMPToJson(p) ! call RTableToJson(p) ! call TDSToJson(p) ! call GasType(3)ToJson(p) ! call PressureDisplayToJson(p) ! call FricPressDropToJson(p) ! call ROP_SpecToJson(p) ! call ROP_BitToJson(p) ! call TDGeoToJson(p) ! call F_String(:)ToJson(p) ! call F_CountsToJson(p) ! call F_Interval(:)ToJson(p) ! call OD_Annulus(4)ToJson(p) ! call TD_DrillStemToJson(p) ! call TD_DrillStemsToJson(p) ! call TD_StringToJson(p) ! call TD_CountToJson(p) ! call G_StringElementToJson(p) ! call TD_VolToJson(p) ! call TD_GeneralToJson(p) ! call TD_BOPToJson(p) ! call TD_BOPElement(4)ToJson(p) ! call TD_StConnToJson(p) ! call TD_LoadToJson(p) ! call TD_WellElToJson(p) ! call TD_CasingToJson(p) ! call TD_LinerToJson(p) ! call TD_OpenHoleToJson(p) ! call TD_ROPHoleToJson(p) ! call TD_WellGeneralToJson(p) ! call TD_WellGeo(:)ToJson(p) ! 2. add member of data type to new node ! 3. add new node to parent call json%add(parent,p) end subroutine !use this as a template subroutine notificationsToJson(parent) type(json_value),pointer :: parent type(json_core) :: json type(json_value),pointer :: p ! 1. create new node call json%create_object(p,'Notifications') ! 2. add member of data type to new node ! 3. add new node to parent call json%add(parent,p) end subroutine end module Simulator